1#! perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
5use File::Spec;
6use Cwd;
7
8# List explicitly here the variables you want Configure to
9# generate.  Metaconfig only looks for shell variables, so you
10# have to mention them as if they were shell variables, not
11# %Config entries.  Thus you write
12#  $startperl
13# to ensure Configure will look for $Config{startperl}.
14# Wanted:  $archlibexp
15
16# This forces PL files to create target in same directory as PL file.
17# This is so that make depend always knows where to find PL derivatives.
18my $origdir = cwd;
19my $dir = dirname($0);
20# This is expanded below for PERL_CORE tests
21my $srcdir = Cwd::abs_path(File::Spec->catdir(
22                  Cwd::abs_path($dir), "..", "..", ".."));
23chdir $dir;
24my $file = basename($0, '.PL');
25$file .= '.com' if $^O eq 'VMS';
26
27open OUT,">", $file or die "Can't create $file: $!";
28
29print "Extracting $file (with variable substitutions)\n";
30
31# In this section, perl variables will be expanded during extraction.
32# You can use $Config{...} to use Configure variables.
33
34print OUT <<"!GROK!THIS!";
35$Config{startperl}
36    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
37    if \$running_under_some_shell;
38--\$running_under_some_shell;
39!GROK!THIS!
40
41# In the following, perl variables are not expanded during extraction.
42
43print OUT <<'!NO!SUBS!';
44
45# Version 2.0, Simon Cozens, Thu Mar 30 17:52:45 JST 2000
46# Version 2.01, Tom Christiansen, Thu Mar 30 08:25:14 MST 2000
47# Version 2.02, Simon Cozens, Sun Apr 16 01:53:36 JST 2000
48# Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001
49# Version 2.04, Enache Adrian, Fri, 18 Jul 2003 23:15:37 +0300
50# Version 2.05, Reini Urban, 2009-12-01 00:00:13
51# Version 2.06, Reini Urban, 2009-12-28 21:56:15
52# Version 2.07, Reini Urban, 2010-06-30 22:32:20
53# Version 2.08, Reini Urban, 2010-07-30 21:30:33
54# Version 2.09, Reini Urban, 2010-10-11 13:54:52
55# Version 2.10, Reini Urban, 2011-02-11 22:58:37
56# Version 2.11, Reini Urban, 2011-04-11 20:16:00
57# Version 2.12, Reini Urban, 2011-10-02 05:19:00
58# Version 2.13, Reini Urban, 2012-01-10 13:03:00
59# Version 2.14, Reini Urban, 2012-02-28 09:04:07
60# Version 2.15, Reini Urban, 2013-02-01 10:41:54
61# Version 2.16, Reini Urban, 2013-11-27 11:36:13
62# Version 2.17, Reini Urban, Thu Feb 6 14:04:29 2014 -0600
63# Version 2.18, Reini Urban, 2014-05-28
64# Version 2.19, Reini Urban, 2014-07-09
65# Version 2.20, Reini Urban, 2014-07-23
66# Version 2.21, Reini Urban, 2016-06-12
67# Version 2.22, Reini Urban, 2017-07-23
68# Version 2.23, Reini Urban, 2018-10-31
69# Version 2.24, Reini Urban, 2018-11-18 (--cross)
70
71use strict;
72use warnings;
73use 5.006_000;
74
75use FileHandle;
76use Config;
77use Fcntl qw(:DEFAULT :flock);
78use File::Temp qw(tempfile);
79use File::Basename qw(basename dirname);
80use File::Path qw(mkpath);
81# use Cwd;
82use Pod::Usage;
83# Time::HiRes does not work with 5.6
84use Time::HiRes qw(gettimeofday tv_interval sleep);
85our $VERSION = 2.24;
86$| = 1;
87eval { require B::C::Config; };
88
89$SIG{INT} = sub { exit(); } if exists $SIG{INT}; # exit gracefully and clean up after ourselves.
90
91use subs qw{
92    cc_harness check_read check_write checkopts_byte choose_backend
93    compile_byte compile_cstyle compile_module generate_code
94    grab_stash parse_argv sanity_check vprint yclept spawnit
95    vsystem
96}; # gettimeofday tv_interval
97sub opt(*); # imal quoting
98sub is_winlike();
99sub is_win32();
100sub is_msvc();
101
102our ($Options, $BinPerl, $Backend);
103our ($Input => $Output);
104our ($logfh);
105our ($cfile);
106our (@begin_output); # output from BEGIN {}, for testsuite
107our ($extra_libs);
108
109# eval { main(); 1 } or die;
110
111main();
112
113sub main {
114    parse_argv();
115    check_write($Output);
116    choose_backend();
117    generate_code();
118    run_code();
119    _die("Not reached?");
120}
121
122#######################################################################
123
124sub choose_backend {
125    # Choose the backend.
126    $Backend = 'C';
127    if (opt('B')) {
128        checkopts_byte();
129        $Backend = 'Bytecode';
130    }
131    if (opt('S') && opt('c')) {
132        # die "$0: Do you want me to compile this or not?\n";
133        delete $Options->{S};
134    }
135    $Backend = 'CC' if opt('O');
136}
137
138sub generate_code {
139
140    vprint 4, "Compiling $Input";
141
142    $BinPerl  = yclept();  # Calling convention for perl.
143
144    if (exists $Options->{m}) {
145        compile_module();
146    } else {
147        if ($Backend eq 'Bytecode') {
148            compile_byte();
149        } else {
150            compile_cstyle();
151        }
152    }
153    exit(0) if (!opt('r'));
154}
155
156sub run_code {
157    if ($Backend eq 'Bytecode') {
158        if ($] < 5.007) {
159            $Output = "$BinPerl -MByteLoader $Output";
160        } else {
161            $Output = "$BinPerl $Output";
162        }
163    }
164    if (opt('staticxs') and $extra_libs) {
165        my $path = '';
166        my $PATHSEP = $^O eq 'MSWin32' ? ';' : ':';
167        for (split / /, $extra_libs) {
168            s{/[^/]+$}{};
169            # XXX qx quote?
170            $path .= $PATHSEP.$_ if $_;
171        }
172        if ($^O =~ /^MSWin32|msys|cygwin$/) {
173            $ENV{PATH} .= $path;
174            vprint 0, "PATH=\$PATH$path";
175        } elsif ($^O ne 'darwin') {
176            $ENV{LD_LIBRARY_PATH} .= $path;
177            vprint 0, "LD_LIBRARY_PATH=\$LD_LIBRARY_PATH$path";
178        }
179    }
180    vprint 0, "Running code $Output @ARGV";
181    system(join(" ",$Output,@ARGV));
182    exit(0);
183}
184
185# usage: vprint [level] msg args
186sub vprint {
187    my $level;
188    if (@_ == 1) {
189        $level = 1;
190    } elsif ($_[0] =~ /^-?\d$/) {
191        $level = shift;
192    } else {
193        # well, they forgot to use a number; means >0
194        $level = 0;
195    }
196    my $msg = "@_";
197    $msg .= "\n" unless substr($msg, -1) eq "\n";
198    if (opt('v') > $level)
199    {
200	if (opt('log')) {
201	    print $logfh "$0: $msg" ;
202	} else {
203	    print        "$0: $msg";
204	}
205    }
206}
207
208sub vsystem {
209    if (opt('dryrun')) {
210        print "@_\n";
211    } else {
212       system(@_);
213    }
214}
215
216sub parse_argv {
217
218    use Getopt::Long;
219
220    # disallows using long arguments
221    Getopt::Long::Configure("bundling");
222    Getopt::Long::Configure("no_ignore_case");
223
224    # no difference in exists and defined for %ENV; also, a "0"
225    # argument or a "" would not help cc, so skip
226    unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
227
228    $Options = {};
229    # support single dash -Wb. GetOptions requires --Wb with bundling enabled.
230    if (my ($wb) = grep /^-Wb=.+/, @ARGV) {
231        $Options->{Wb} = $Options->{Wb} ? $Options->{Wb}.",".substr($wb,4) : substr($wb,4);
232        @ARGV = grep !/^-Wb=(.+)/, @ARGV;
233    }
234    # -O2 i.e. -Wb=-O1 (new since 2.13)
235    if (my ($o1) = grep /^-O(\d)$/, @ARGV) {
236        $Options->{Wb} = $Options->{Wb} ? $Options->{Wb}.",$o1" : $o1;
237        @ARGV = grep !/^-O\d$/, @ARGV;
238    }
239    if (my ($v) = grep /^-v\d$/, @ARGV) {
240        $Options->{v} = 0+substr($v,2);
241        @ARGV = grep !/^-v\d$/, @ARGV;
242    }
243    if (my ($m) = grep /^-m(\w+)$/, @ARGV) { # TODO: until next arg without -
244        $Options->{m} = $1;
245        @ARGV = grep !/^-m(\w+)$/, @ARGV;
246    }
247    if (grep /^-stash$/, @ARGV) {
248        $Options->{stash}++;
249        @ARGV = grep !/^-stash$/, @ARGV;
250    }
251    $Options->{spawn} = 1 unless $^O eq 'MSWin32';
252    Getopt::Long::GetOptions( $Options,
253        'L=s@',         # lib directories
254        'I=s@',         # include directories (FOR C, NOT FOR PERL)
255        'o=s',          # Output executable
256        'v:i',          # Verbosity level
257        'e=s',          # One-liner
258        'm|sharedlib:s',# as Module [name] (new since 2.11, not yet tested)
259	'r',            # run resulting executable
260        'B',            # Byte compiler backend
261        'O',            # Optimised C backend B::CC
262         #'O1-4'        # alias for -Wb=-O1 (new since 2.13)
263        'debug|D',      # alias for --Wb=-Dfull and -S to enable all debug and preserve source code
264        'dryrun|n',     # only print commands, do not execute
265        'c',            # Compile to C only, no linking
266        'check',        # pass -c to B::C and exit
267        'cross=s',      # pathto/config.sh (new since 2.24)
268        'help|h',       # Help me
269        'S',            # Keep generated C file
270        'T',            # run the backend using perl -T
271        't',            # run the backend using perl -t
272        'A',            # -DALLOW_PERL_OPTIONS like -D?
273        'u=s@',         # use packages (new since 2.13)
274        'U=s@',         # skip packages (new since 2.13)
275        'static',       # Link to static libperl (default, new since 2.11)
276        'shared',       # Link to shared libperl (new since 2.07)
277        'staticxs',     # Link static XSUBs (new since 2.07)
278        'sharedxs',     # Link shared XSUBs (default, new since 2.07))
279        'stash',        # Detect external packages via B::Stash
280	'log:s',        # where to log compilation process information
281        'Wb=s',         # pass (comma-seperated) options to backend
282        'f=s@',         # pass compiler option(s) to backend (new since 2.14)
283        'Wc=s',         # pass (comma-seperated) options to cc (new since 2.13)
284        'Wl=s',         # pass (comma-seperated) options to ld (new since 2.13)
285        'testsuite',    # try to be nice to testsuite modules (STDOUT, STDERR handles)
286        'spawn!',	# --no-spawn (new since 2.12)
287        'time',         # print benchmark timings (new since 2.08)
288        'version',      # (new since 2.13)
289    );
290
291    if ( $Options->{debug} ) {
292        $Options->{Wb} = $Options->{Wb} ? $Options->{Wb} . ',' : '';
293        $Options->{Wb} .= '-Dfull';
294        $Options->{S} = 1;
295    }
296
297    $Options->{v} += 0;
298
299    if( opt('t') && opt('T') ) {
300        warn "Can't specify both -T and -t, -t ignored";
301        $Options->{t} = 0;
302    }
303
304    helpme() if opt('help'); # And exit
305    if (opt('version')) {
306      die version();
307    }
308
309    # $Options->{Wb} .= ",-O1" if opt('O1');
310    # $Options->{Wb} .= ",-O2" if opt('O2');
311    # $Options->{Wb} .= ",-O3" if opt('O3');
312    # $Options->{Wb} .= ",-O4" if opt('O4');
313    $Options->{Wc} .= " -DALLOW_PERL_OPTIONS" if opt('A');
314
315    if( $Options->{time} or $Options->{spawn} ) {
316      # eval { require Time::HiRes; }; # 5.6 has no Time::HiRes
317      # if ($@) {
318      #  warn "--time ignored. No Time::HiRes\n" if $Options->{time};
319      #  $Options->{time} = 0;
320      #} else {
321        # *gettimeofday = *Time::HiRes::gettimeofday;
322        Time::HiRes::gettimeofday();
323        # Time::HiRes->import('gettimeofday','tv_interval','sleep');
324      #}
325    }
326    $logfh  = new FileHandle(">> " . opt('log')) if (opt('log'));
327
328    if (opt('e')) {
329        warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV;
330        # We don't use a temporary file here; why bother?
331        # XXX: this is not bullet proof -- spaces or quotes in name!
332        $Input = is_win32() ? # Quotes eaten by shell
333            '-e "'.opt('e').'"' :
334            "-e '".opt('e')."'";
335    } else {
336        $Input = shift @ARGV;  # XXX: more files?
337        _usage_and_die("No input file specified\n") unless $Input;
338        # DWIM modules. This is bad but necessary.
339        $Options->{m} = '' if $Input =~ /\.pm\z/ and !opt('m') and !opt('r');
340        vprint 1, "$0: using $Input as input file, ignoring @ARGV\n" if @ARGV;
341        check_read($Input);
342        check_perl($Input);
343    }
344
345    if (exists $Options->{m} and opt('r')) {
346        _die("Cannot run a module\n");
347    }
348    if (opt('o')) {
349        $Output = opt('o');
350        if (!opt('B') and is_winlike() and $Output !~ /\.[A-Za-z0-9]{3}$/) {
351            $Output .= '.exe';
352        }
353        $Output = relativize($Output) unless is_win32();
354    } elsif (opt('B')) {
355        if (opt('e')) {
356            my $suffix = '.plc';
357            $suffix = '.pmc' if exists $Options->{m};
358            (undef, $Output) = tempfile("plcXXXXX", SUFFIX => $suffix);
359        } else {
360            $Output = basename($Input) . "c";
361        }
362         $Output = relativize($Output) unless is_win32();
363     } elsif (exists $Options->{m} and !opt('e')) {
364         my $module = module_name();
365         # shared lib along auto. see algo in DynaLoader
366         my @modparts = split(/::/,$module);
367         my $modfname = $modparts[-1];
368         $modfname = &mod2fname(\@modparts) if defined &mod2fname;
369         my $modpname = join('/',@modparts);
370         my $dlext = $Config::Config{dlext};
371         my $dir = $Config::Config{sitearch}."/pcc";
372         eval { mkpath $dir; };
373         $dir = "~/.perl5/pcc" unless -w $dir;
374         if (! -d "$dir/$modpname") {
375             mkpath "$dir/$modpname"
376               or die "perlcc -m: Failed to mkdir $dir/$modpname\n";
377         }
378         $Output = "$dir/$modpname/$modfname.$dlext";
379    } else {
380        $Output = opt('e') ? 'a.out' : $Input;
381        $Output =~ s/\.(p[lm]|t)$//;
382        if ($Options->{m} or opt('shared')) {
383            $Output .= ".".$Config{dlext};
384        } elsif (is_winlike()) {
385            if ($Output eq 'a.out') {
386                $Output = 'a.exe';
387            } else {
388                $Output .= '.exe';
389            }
390        }
391        $Output = relativize($Output) unless is_win32();
392    }
393    sanity_check();
394}
395
396sub opt(*) {
397    my $opt = shift;
398    return exists($Options->{$opt}) && ($Options->{$opt} || 0);
399}
400
401sub module_name {
402    my $name = $Options->{m};
403    unless ($name) {
404        $name = $Input;
405        $name =~ s/\.p[lm]$//;
406        if (basename($name) ne $name) {
407            my $base = basename($name);
408            # find first uppercase dirname
409            my $m = '';
410            my @list = split(/\//, $name);
411            pop @list;
412            for (@list) {
413                if (/^[A-Z]/) {
414                    $m .= $_."::";
415                } elsif (/^[a-z]/) {
416                    $m = '';
417                }
418            }
419            $name = $m ? $m.$base : $base;
420        }
421    }
422    $Options->{m} = $name;
423}
424
425sub compile_module {
426    my $name = module_name();
427    if ($Backend eq 'Bytecode') {
428        compile_byte("-m$name");
429    } else {
430        compile_cstyle("-m$name");
431    }
432}
433
434sub compile_byte {
435
436    vprint 3, "Writing B on $Output";
437    my $opts = $] < 5.007 ? "" : "-H,-s,";
438    if ($] >= 5.007 and $Input =~ /^-e/) {
439        $opts = "-H,";
440    }
441    if (@_ == 1) {
442        $opts .= $_[0].",";
443    }
444    my $addoptions = opt('Wb');
445    if (opt('v') > 4) {
446        $opts .= '-v,';
447        $opts .= '-DM,-DG,-DA,-DComment,' if opt('v') > 5;
448    }
449    #if ($Options->{cross}) {
450    #    $opts .= '-cross='.$Options->{cross}.',';
451    #}
452    $opts .= "$addoptions," if $addoptions;
453    my $command = "$BinPerl -MO=Bytecode,$opts-o$Output $Input";
454    $Input =~ s/^-e.*$/-e/;
455    vprint 5, "Compiling...";
456    vprint 0, "Calling $command";
457
458    my $t0 = [gettimeofday] if opt('time');
459    my ($output_r, $error_r, $errcode) = spawnit($command);
460    my $elapsed = tv_interval ( $t0 ) if opt('time');
461    vprint -1, "c time: $elapsed" if opt('time');
462
463    if (@$error_r && $errcode != 0) {
464	_die("$Input did not compile $errcode:\n@$error_r\n");
465    } else {
466	my @error = grep { !/^$Input syntax OK$/o } @$error_r;
467	@error = grep { !/^No package specified for compilation, assuming main::$/o } @error;
468	warn "$0: Unexpected compiler output\n@error" if @error and opt('v')<5;
469	warn "@error" if @error and opt('v')>4;
470    }
471
472    unless (opt('dryrun')) {
473      chmod 0777 & ~umask, $Output    or _die("can't chmod $Output: $!\n");
474    }
475}
476
477sub compile_cstyle {
478    my $stash = opt('stash') ? grab_stash() : "";
479    $stash .= "," if $stash; #stash can be empty
480    $stash .= "-u$_," for @{$Options->{u}};
481    $stash .= "-U$_," for @{$Options->{U}};
482
483    #if ($ENV{PERL_CORE} and ($Config{ccflags} =~ /-m32/ or $Config{cc} =~ / -m32/)) {
484    #    die "perlcc with -m32 cross compilation is not supported\n";
485    #}
486
487    my $taint = opt('T') ? ' -T' :
488                opt('t') ? ' -t' : '';
489
490    # What are we going to call our output C file?
491    my $lose = 0;
492    my ($cfh);
493    my $testsuite = '';
494    my $addoptions = '';
495    if (@_) {
496        $addoptions = join(",",@_);
497    }
498    $addoptions .= opt('Wb') ? opt('Wb')."," : "";
499    if( $addoptions ) {
500        $addoptions .= ',-Dfull' if opt('v') >= 6;
501        if (opt('v') == 5) {
502            $addoptions .= opt('O') ? ',-DstFl,-v' : ',-DspF,-v';
503        }
504        $addoptions .= ',';
505    } elsif (opt('v') > 4) {
506        $addoptions = opt('O') ? '-DstFl,-v,' : '-DspF,-v,';
507        $addoptions = '-Dfull,-v,' if opt('v') >= 6;
508    }
509    if (opt('f')) {
510        $addoptions .= "-f$_," for @{$Options->{f}};
511    }
512    if (opt('check')) {
513        $addoptions .= "-c,";
514    }
515    if (opt('cross')) {
516        $addoptions .= '-cross='.$Options->{cross}.',';
517    }
518    $addoptions =~ s/,,/,/g;
519
520    my $staticxs = opt('staticxs') ? "-staticxs," : '';
521    warn "Warning: --staticxs on darwin is very experimental\n"
522        if $staticxs and $^O eq 'darwin';
523    if (opt('testsuite')) {
524        my $bo = join '', @begin_output;
525        $bo =~ s/\\/\\\\\\\\/gs;
526        $bo =~ s/\n/\\n/gs;
527        $bo =~ s/,/\\054/gs;
528        # don't look at that: it hurts
529        $testsuite = q{-fuse-script-name,-fsave-data,-fsave-sig-hash,}.
530            qq[-e"print q{$bo}",] .
531            q{-e"open(Test::Builder::TESTOUT\054 '>&STDOUT') or die $!",} .
532            q{-e"open(Test::Builder::TESTERR\054 '>&STDERR') or die $!",};
533    }
534    if (opt('check')) {
535        $cfile = "";
536        $staticxs = "";
537    } elsif (opt('o')) {
538        $cfile = opt('o').".c";
539        if (is_winlike() and $Output =~ /\.exe.c$/) {
540          $cfile =~ s/\.exe\.c$/.c/,
541        }
542    } elsif (opt('S') || opt('c')) { # We need to keep it
543        if (opt('e')) {
544            $cfile = $Output;
545            if (is_winlike() and $Output =~ /\.exe$/) {
546                $cfile =~ s/\.exe$//,
547            }
548            $cfile .= '.c';
549        } else {
550            $cfile = basename($Input);
551            # File off extension if present
552            # hold on: plx is executable; also, careful of ordering!
553            $cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i;
554            $cfile .= ".c";
555            $cfile = $Output if opt('c') && $Output =~ /\.c\z/i;
556        }
557        check_write($cfile);
558    } else { # Do not keep tempfiles (no -S nor -c nor -o)
559        $lose = 1;
560        ($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c");
561        close $cfh; # See comment just below
562    }
563    vprint 3, "Writing C on $cfile" unless opt('check');
564
565    my $max_line_len = '';
566    if (is_msvc) {
567        $max_line_len = '-l2000,';
568    }
569
570    my $options = "$addoptions$testsuite$max_line_len$staticxs$stash";
571    $options .= "-o$cfile" unless opt('check');
572    $options = substr($options,0,-1) if substr($options,-1,1) eq ",";
573    # This has to do the write itself, so we can't keep a lock. Life sucks.
574
575    my $command = "$BinPerl$taint -MO=$Backend,$options $Input";
576    vprint 5, "Compiling...";
577    vprint 0, "Calling $command";
578
579    my $t0 = [gettimeofday] if opt('time');
580    my ($output_r, $error_r, $errcode) = spawnit($command);
581    my $elapsed = tv_interval ( $t0 ) if opt('time');
582    my @output = @$output_r;
583    my @error = @$error_r;
584
585    if (@error && $errcode != 0) {
586        _die("$Input did not compile, which can't happen $errcode:\n@error\n");
587    } else {
588        my $i = substr($Input,0,2) eq '-e' ? '-e' : $Input;
589        @error = grep { !/^$i syntax OK$/o } @error;
590        if (opt('check')) {
591            print "@error" if @error;
592        } else {
593            warn "$0: Unexpected compiler output\n@error" if @error and opt('v')<5;
594            warn "@error" if @error and opt('v')>4;
595        }
596    }
597    vprint -1, "c time: $elapsed" if opt('time');
598    $extra_libs = '';
599    my %rpath;
600    if ($staticxs and open(XS, "<", $cfile.".lst")) {
601        while (<XS>) {
602            my ($s, $l) = m/^([^\t]+)(.*)$/;
603            next if grep { $s eq $_ } @{$Options->{U}};
604            $stash .= ",-u$s";
605            if ($l) {
606                $l = substr($l,1);
607                if ($^O eq 'darwin' and $l =~/\.bundle$/) {
608                    my $ofile = $l;
609                    $ofile =~ s/\.bundle$/.o/;
610                    $ofile =~ s{^.*/auto/}{};
611                    $ofile =~ s{(.*)/[^/]+\.o}{$1.o};
612                    $ofile =~ s{/}{_}g;
613                    $ofile = 'pcc'.$ofile;
614                    if (-e $ofile) {
615                        vprint 3, "Using ".$ofile;
616                    } else {
617                        vprint 3, "Creating ".$ofile;
618                        # This fails sometimes
619                        my $cmd = "otool -tv $l | \"$^X\" -pe "
620        . q{'s{^/}{# .file /};s/^00[0-9a-f]+\s/\t/;s/^\(__(\w+)(,__.*?)?\) section/q(.).lc($1)/e'}
621        . " | as -o \"$ofile\"";
622                        vprint 3, $cmd;
623                        vsystem($cmd);
624                    }
625                    $extra_libs .= " ".$l if -e $ofile;
626                } else {
627                    $extra_libs .= " ".$l;
628                    $rpath{dirname($l)}++;
629                }
630            }
631        }
632        close XS;
633        my ($rpath) = $Config{ccdlflags} =~ /^(.+rpath,)/;
634        ($rpath) = $Config{ccdlflags} =~ m{^(.+-R,)/} unless $rpath;
635        if (!$rpath and $Config{gccversion}) {
636            $rpath = '-Wl,-rpath,';
637        }
638        $rpath =~ s/^-Wl,-E// if $rpath;         # already done via ccdlflags
639        # $extra_libs .= " $rpath".join(" ".$rpath,keys %rpath) if $rpath and %rpath;
640        vprint 4, "staticxs: $stash $extra_libs";
641    }
642    exit if opt('check');
643
644    $t0 = [gettimeofday] if opt('time');
645    is_msvc ?
646        cc_harness_msvc($cfile, $stash, $extra_libs) :
647        cc_harness($cfile, $stash, $extra_libs) unless opt('c');
648    $elapsed = tv_interval ( $t0 ) if opt('time');
649    vprint -1, "cc time: $elapsed" if opt('time');
650
651    if ($lose and -s $Output) {
652        vprint 3, "Unlinking $cfile";
653        unlink $cfile or _die("can't unlink $cfile: $!\n");
654    }
655}
656
657sub cc_harness_msvc {
658    my ($cfile, $stash, $extra_libs) = @_;
659    use ExtUtils::Embed ();
660    my $obj = $Output;
661    $obj =~ s/\.exe$/.obj/;
662    $obj .= ".obj" unless $obj =~ /\.obj$/;
663    my $compile = "";
664    $compile = '-I"..\..\lib\CORE" ' if $ENV{PERL_CORE};
665    my $ccopts = ExtUtils::Embed::ccopts();
666    my $optWc = opt('Wc');
667    # suppress cl : Command line warning D4025 : overriding '/O1' with '/Od'
668    $ccopts =~ s/\b[-\/]O.\b/-Od/ if $optWc && ($optWc =~ /\b[-\/]Od\b/);
669    $compile .= "$ccopts -c -Fo$obj $cfile ";
670    $compile .= " -DHAVE_INDEPENDENT_COMALLOC" if $B::C::Config::have_independent_comalloc;
671    $compile .= $B::C::Config::extra_cflags;
672    my $link = "-out:$Output $obj";
673    my $incdir = opt('I'); # use mult. I opts for paths with spaces, and \ deps.
674    if ($incdir) {
675        if (ref $incdir eq 'ARRAY') { # -I uses now mult.
676            $compile .= ' -I"'.$_.'"' for @$incdir;
677        } else {
678            $compile .= ' -I"'.$incdir.'"';
679        }
680    }
681    $compile .= ' -DSTATICXS' if opt('staticxs');
682    $compile .= " $optWc" if $optWc;
683
684    $link .= ' -libpath:"..\..\lib\CORE"' if $ENV{PERL_CORE};
685    my $libdir = opt('L');
686    if ($libdir) {
687        if (ref $libdir eq 'ARRAY') {
688            $link .= ' -L"'.$_.'"' for @$libdir;
689        } else {
690            $link .= ' -L"'.$libdir.'"';
691        }
692    }
693    if (exists $Options->{m} or $Options->{shared}) {
694      $link .= " -shared";
695    }
696    # TODO: -shared,-static,-sharedxs
697    if ($stash) {
698        my @mods = split /,?-?u/, $stash; # XXX -U stashes
699        $link .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
700        # XXX staticxs need to check if the last mods for staticxs found a static lib.
701        # XXX only if not use the extra_libs
702    } else {
703        $link .= " ".ExtUtils::Embed::ldopts("-std");
704    }
705    if ($Config{ccversion} eq '12.0.8804') {
706        $link =~ s/ -opt:ref,icf//;
707    }
708    $link .= " ".$Config{optimize};
709    $link .= " ".opt('Wl') if opt('Wl');
710    if (opt('staticxs')) { # TODO: can msvc link to dll's directly? otherwise use dlltool
711        $extra_libs =~ s/^\s+|\s+$//g; # code by stengcode@gmail.com
712        foreach (split /\.dll(?:\s+|$)/, $extra_libs) {
713            $_ .= '.lib';
714            if (!-e $_) {
715                die "--staticxs requires $_, you should copy it from build area";
716            }
717            else {
718              $link .= ' ' . $_;
719            }
720        }
721    } else {
722        $link .= $extra_libs;
723    }
724
725    # another ldopts bug: ensure Win32CORE gets added.
726    if (index($link, "Win32CORE") < 0) {
727        my $archdir = $ENV{PERL_CORE} ? "../.." : $Config{archlib};
728        my $win32core = "-L$archdir/lib/auto/Win32CORE -lWin32CORE";
729        if (-e "$archdir/lib/auto/Win32CORE/Win32CORE.a") {
730            $win32core = "$archdir/lib/auto/Win32CORE/Win32CORE.a";
731        }
732        $link .= " $win32core";
733    }
734    if ($Config{usecperl}) {
735        $link .= " cperl5$Config{PERL_VERSION}.lib";
736    } else {
737        $link .= " perl5$Config{PERL_VERSION}.lib";
738    }
739    $link .= " kernel32.lib msvcrt.lib";
740    $link .= $B::C::Config::extra_libs;
741    vprint 3, "Calling $Config{cc} $compile";
742    if (!opt('dryrun')) {
743        my @output = split /\n/, `$Config{cc} $compile`;
744        @output = grep {$_ ne $cfile} @output;
745        print STDERR join("\n", @output);
746    }
747    vprint 3, "Calling $Config{ld} $link";
748    if (!opt('dryrun')) {
749        my @output = split /\n/, `$Config{ld} $link`;
750        @output = grep {!/(Creating library|Generating code|Finished generating code)/} @output;
751        print STDERR join("\n", @output);
752    }
753}
754
755sub cc_harness {
756    my ($cfile, $stash, $extra_libs) = @_;
757    use ExtUtils::Embed ();
758    my $command = ExtUtils::Embed::ccopts." -o \"$Output\" \"$cfile\" ";
759    my $coredir;
760    if ($ENV{PERL_CORE}) {
761!NO!SUBS!
762print OUT <<"!EXPANDED!";
763      \$coredir = \"$srcdir\";
764      \$coredir .= \"/lib/CORE\" if \$^O eq 'MSWin32'; # forward slashes yes
765      \$command = "\$Config{optimize} \$Config{ccflags} -I\\\"\$coredir\\\" -L\\\"\$coredir\\\" -o \\\"\$Output\\\" \\\"\$cfile\\\" ";
766!EXPANDED!
767print OUT <<'!NO!SUBS!';
768    }
769    $command .= " -DHAVE_INDEPENDENT_COMALLOC" if $B::C::Config::have_independent_comalloc;
770    $command .= $B::C::Config::extra_cflags if $B::C::Config::extra_cflags;
771    my $incdir = opt('I'); # use mult. I opts for paths with spaces, and \ deps.
772    if ($incdir) {
773        if (ref $incdir eq 'ARRAY') {
774            $command .= ' -I"'.$_.'"' for @$incdir;
775        } else {
776            $command .= ' -I"'.$incdir.'"';
777        }
778    }
779    my $libopt = opt('L');
780    if ($libopt) {
781        if (ref $libopt eq 'ARRAY') {
782            $command .= ' -L"'.$_.'"' for @$libopt;
783        } else {
784            $command .= ' -L"'.$libopt.'"';
785        }
786    }
787    $command .= " -DSTATICXS" if opt('staticxs');
788    my $optWc = opt('Wc');
789    if ($optWc) {
790        $command .= " $optWc";
791        # no override warning
792        $command =~ s/\b-O.\b/-O0/ if $optWc =~ /\b-O0\b/;
793    }
794    my $ccflags = $command;
795
796    my $useshrplib = $Config{useshrplib} =~ /^(true|yes)$/;
797    _die("--sharedxs with useshrplib=false\n") if !$useshrplib and opt('sharedxs');
798    my $ldopts;
799    if ($stash) {
800        my @mods = split /,?-?u/, $stash; # XXX -U stashes
801        $ldopts = ExtUtils::Embed::ldopts("-std", \@mods);
802    } else {
803        if ($ENV{PERL_CORE} and $^O eq 'MSWin32') {
804            $ldopts = $Config{libs};
805        } else {
806            $ldopts = ExtUtils::Embed::ldopts("-std"); # critical on mingw
807        }
808    }
809    $ldopts .= " ".opt('Wl') if opt('Wl');
810
811    # gcc crashes with this duplicate -fstack-protector arg
812    my $ldflags = $Config{ldflags};
813    if ($^O eq 'cygwin' and $ccflags =~ /-fstack-protector /
814                        and $ldopts =~ /-fstack-protector /)
815    {
816        $ldopts =~ s/-fstack-protector //;
817        $ldflags =~ s/-fstack-protector // if $extra_libs;
818    }
819    # another ldopts bug: ensure Win32CORE gets added, before -lperl
820    if (is_winlike()) {
821        if (index($ldopts, "Win32CORE") < 0) {
822           my $archdir = $ENV{PERL_CORE} ? "../.." : $Config{archlib};
823           my $win32core = "-L$archdir/lib/auto/Win32CORE -lWin32CORE";
824           if (-e "$archdir/lib/auto/Win32CORE/Win32CORE.a") {
825               $win32core = "$archdir/lib/auto/Win32CORE/Win32CORE.a";
826           }
827           if ($ldopts =~ m{ (-lc?perl)}) {
828               $ldopts =~ s{ (-lc?perl)}{ $win32core $1};
829           } else {
830               $ldopts .= " $win32core";
831           }
832        }
833    }
834    my ($libperl, $libdir) = ($Config{libperl});
835    if ($ENV{PERL_CORE}) {
836        # on mingw we still search for cperl52x.dll not the importlib
837        # coredir + includedir is ../../lib/CORE on windows
838        $libdir = "../..";
839        # $ldopts .= " -L$coredir" if $^O eq 'MSWin32';
840    } else {
841        $libdir  = $Config{prefix} . "/lib";
842        $coredir = $ENV{PERL_SRC} || $Config{archlib}."/CORE";
843    }
844    if ($extra_libs) {
845        # splice extra_libs after $Config{ldopts} before @archives
846        my $i_ldopts = index($ldopts, $ldflags);
847        if ($ldflags and $i_ldopts >= 0) {
848            my $l = $i_ldopts + length($ldflags);
849            $ldopts = substr($ldopts,0,$l).$extra_libs." ".substr($ldopts,$l);
850        } else {
851            $ldopts = $extra_libs." ".$ldopts;
852        }
853    }
854    if (exists $Options->{m} or opt('shared')) {
855      $ldopts = "-shared $ldopts";
856    }
857    if (opt('shared')) {
858        warn "--shared with useshrplib=false might not work\n" unless $useshrplib;
859        my @plibs = ($libperl, "$coredir/$libperl", "$libdir/$libperl");
860	if ($libperl !~ /$Config{dlext}$/) {
861            $libperl = "libperl.".$Config{dlext};
862            @plibs = ($libperl, "$coredir/$libperl", "$libdir/$libperl");
863            push @plibs, glob "$coredir/*perl5*".$Config{dlext};
864            push @plibs, glob "$coredir/*perl.".$Config{dlext};
865            push @plibs, glob $libdir."/*perl5*.".$Config{dlext};
866            push @plibs, glob $libdir."/*perl.".$Config{dlext};
867            push @plibs, glob $Config{bin}."/perl*.".$Config{dlext};
868        }
869        for my $lib (@plibs) {
870            if (-e $lib) {
871	        $ldopts =~ s|-lc?perl |$lib |;
872	        $ldopts =~ s|\s+\S+libc?perl\w+\.a | $lib |;
873	        $ldopts = "$coredir/DynaLoader.o $ldopts" if -e "$coredir/DynaLoader.o";
874	        last;
875            }
876        }
877    } elsif (opt('static')) {
878        for my $lib ($libperl, "$coredir/$libperl", "$coredir/$libperl",
879                   "$coredir/libperl.a", "$libdir/libperl.a", "$coredir/libcperl.a", "$libdir/libcperl.a") {
880            if (-e $lib) {
881	        $ldopts =~ s|-lc?perl |$lib |;
882	        $ldopts = "$coredir/DynaLoader.o $ldopts" if -e "$coredir/DynaLoader.o";
883	        last;
884            }
885        }
886    } else {
887        if ( $useshrplib and -e $libdir."/".$Config{libperl}) {
888	    # debian: only /usr/lib/libperl.so.5.10.1 and broken ExtUtils::Embed::ldopts
889	    $ldopts =~ s|-lperl |$libdir/$Config{libperl} |;
890        }
891        if ( $useshrplib and -e $coredir."/".$Config{libperl}) {
892            # help cygwin debugging, and workaround wrong debian linker prefs (/usr/lib before given -L)
893	    $ldopts =~ s|-lperl |$coredir/$Config{libperl} |;
894        }
895    }
896    unless ( $command =~ m{( -lc?perl|/CORE\/libperl)} ) {
897        if ($Config{usecperl} and $libperl =~ /libcperl/) {
898            $ldopts .= " -lcperl";
899        } else {
900            $ldopts .= " -lperl";
901        }
902        $ldopts .= " $Config{libs}" if $ENV{PERL_CORE}; # no -L found at all
903    }
904    $command .= " ".$ldopts;
905    $command .= $B::C::Config::extra_libs if $B::C::Config::extra_libs;
906    vprint 3, "Calling $Config{cc} $command";
907    vsystem("$Config{cc} $command");
908}
909
910# Where Perl is, and which include path to give it.
911sub yclept {
912    my $command = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
913    # DWIM the -I to be Perl, not C, include directories.
914    if (opt('I') && $Backend eq "Bytecode") {
915        my $incdir = opt('I');
916        if ($incdir) {
917            if (ref $incdir ne 'ARRAY') {
918                $incdir = ($incdir);
919            }
920            for (@$incdir) {
921                if (-d $_) {
922                    push @INC, $_;
923                } else {
924                    warn "$0: Include directory $_ not found, skipping\n";
925                }
926            }
927        }
928    }
929    my %OINC;
930    $OINC{$Config{$_}}++ for (qw(privlib archlib sitelib sitearch vendorlib vendorarch));
931    $OINC{'.'}++ unless ${^TAINT};
932    $OINC{$_}++ for split ':', $Config{otherlibdirs};
933    if (my $incver = $Config{inc_version_list}) {
934        my $incpre = dirname($Config{sitelib});
935        $OINC{$_}++ for map { File::Spec->catdir($incpre,$_) } split(' ',$incver);
936        $OINC{$incpre}++;
937    }
938    for my $i (@INC) {
939        my $inc = $i =~ m/\s/ ? qq{"$i"} : $i;
940        $command .= " -I$inc" unless $OINC{$i}; # omit internal @INC dirs
941    }
942
943    return $command;
944}
945
946# Use B::Stash to find additional modules and stuff.
947{
948    my $_stash;
949    sub grab_stash {
950
951        warn "already called grab_stash once" if $_stash;
952
953        my $taint = opt('T') ? ' -T' :
954                    opt('t') ? ' -t' : '';
955        my $command = "$BinPerl$taint -MB::Stash -c $Input";
956        # Filename here is perfectly sanitised.
957        vprint 3, "Calling $command\n";
958
959        my ($stash_r, $error_r, $errcode) = spawnit($command);
960        my @stash = @$stash_r;
961        my @error = @$error_r;
962
963        if (@error && $errcode != 0) {
964            _die("$Input did not compile $errcode:\n@error\n");
965        }
966
967        # band-aid for modules with noisy BEGIN {}
968        foreach my $i ( @stash ) {
969            $i =~ m/-[ux](?:[\w:]+|\<none\>)$/ and $stash[0] = $i and next;
970            push @begin_output, $i;
971        }
972        chomp $stash[0];
973        $stash[0] =~ s/,-[ux]\<none\>//;
974        $stash[0] =~ s/^.*?-([ux])/-$1/s;
975        vprint 2, "Stash: ", join " ", split /,?-[ux]/, $stash[0];
976        chomp $stash[0];
977        return $_stash = $stash[0];
978    }
979}
980
981# Check the consistency of options if -B is selected.
982# To wit, (-B|-O) ==> no -shared, no -S, no -c
983sub checkopts_byte {
984
985    _die("Please choose one of either -B and -O.\n") if opt('O');
986
987    for my $o ( qw[shared sharedxs static staticxs] ) {
988        if (exists($Options->{$o}) && $Options->{$o}) {
989            warn "$0: --$o incompatible with -B\n";
990            delete $Options->{$o};
991        }
992    }
993    # TODO make -S produce an .asm also?
994    for my $o ( qw[c S] ) {
995        if (exists($Options->{$o}) && $Options->{$o}) {
996            warn "$0: Compiling to bytecode is a one-pass process. ",
997                  "-$o ignored\n";
998            delete $Options->{$o};
999        }
1000    }
1001
1002}
1003
1004# Check the input and output files make sense, are read/writeable.
1005sub sanity_check {
1006    if ($Input eq $Output) {
1007        if ($Input eq 'a.out') {
1008            _die("Compiling a.out is probably not what you want to do.\n");
1009            # You fully deserve what you get now. No you *don't*. typos happen.
1010        } else {
1011            my $suffix = '';
1012            if (exists $Options->{m} or opt('shared')) {
1013                $suffix = ".".$Config{dlext};
1014            } elsif (is_winlike()) {
1015              $suffix = '.exe'
1016            }
1017            (undef, $Output) = tempfile("plcXXXXX", SUFFIX => $suffix);
1018            warn "$0: Will not write output on top of input file, ",
1019                "compiling to $Output instead\n";
1020        }
1021    }
1022}
1023
1024sub check_read {
1025    my $file = shift;
1026    unless (-r $file) {
1027        _die("Input file $file is a directory, not a file\n") if -d _;
1028        unless (-e _) {
1029            _die("Input file $file was not found\n");
1030        } else {
1031            _die("Cannot read input file $file: $!\n");
1032        }
1033    }
1034    unless (-f _) {
1035        # XXX: die?  don't try this on /dev/tty
1036        warn "$0: WARNING: input $file is not a plain file\n";
1037    }
1038}
1039
1040sub check_write {
1041    my $file = shift;
1042    if (-d $file) {
1043        _die("Cannot write on $file, is a directory\n");
1044    }
1045    if (-e _) {
1046        _die("Cannot write on $file: $!\n") unless -w _;
1047    }
1048    unless (-w '.') {
1049        _die("Cannot write in this directory: $!\n");
1050    }
1051}
1052
1053sub check_perl {
1054    my $file = shift;
1055    unless (-T $file) {
1056        warn "$0: Binary `$file' sure doesn't smell like perl source!\n";
1057        print "Checking file type... ";
1058        vsystem("file", $file);
1059        _die("Please try a perlier file!\n");
1060    }
1061
1062    open(my $handle, "<", $file)    or _die("Can't open $file: $!\n");
1063    local $_ = <$handle>;
1064    if (/^#!/ && !/perl/) {
1065        _die("$file is a ", /^#!\s*(\S+)/, " script, not perl\n");
1066    }
1067}
1068
1069# File spawning and error collecting
1070sub spawnit {
1071    my $command = shift;
1072    my (@error,@output,$errname,$errcode);
1073    if (opt('dryrun')) {
1074        print "$command\n";;
1075    }
1076    elsif ($Options->{spawn}) {
1077        (undef, $errname) = tempfile("pccXXXXX");
1078        {
1079	    my $pid = open (S_OUT, "$command 2>$errname |")
1080	      or _die("Couldn't spawn the compiler.\n");
1081            $errcode = $?;
1082            my $kid;
1083            do {
1084              $kid = waitpid($pid, 0);
1085            } while $kid > 0;
1086            @output = <S_OUT>;
1087        }
1088        open (S_ERROR, $errname) or _die("Couldn't read the error file.\n");
1089        @error = <S_ERROR>;
1090        close S_ERROR;
1091        close S_OUT;
1092        unlink $errname or _die("Can't unlink error file $errname\n");
1093    } else {
1094        @output = split /\n/, `$command`;
1095    }
1096    return (\@output, \@error, $errcode);
1097}
1098
1099sub version {
1100    require B::C::Config;
1101    no warnings 'once';
1102    my $BC_VERSION = $B::C::Config::VERSION . $B::C::REVISION;
1103    return "perlcc $VERSION, B-C-${BC_VERSION} built for $Config{perlpath} $Config{archname}\n";
1104}
1105
1106sub helpme {
1107    print version(),"\n";
1108    if (opt('v')) {
1109	pod2usage( -verbose => opt('v') );
1110    } else {
1111	pod2usage( -verbose => 0 );
1112    }
1113}
1114
1115sub relativize {
1116    my ($args) = @_;
1117
1118    return("./".basename($args)) if ($args =~ m"^[/\\]");
1119    return("./$args");
1120}
1121
1122sub _die {
1123    my @args = ("$0: ", @_);
1124    $logfh->print(@args) if opt('log');
1125    print STDERR @args;
1126    exit(); # should die eventually. However, needed so that a 'make compile'
1127            # can compile all the way through to the end for standard dist.
1128}
1129
1130sub _usage_and_die {
1131    _die(<<EOU);
1132Usage:
1133$0 [-o executable] [-h][-r] [-O|-B|-c|-S] [-I /foo] [-L /foo] [--log log] [source[.pl] | -e code]
1134More options (see perldoc perlcc)
1135  -v[1-4]
1136  --stash     --staticxs --shared --static
1137  --testsuite --time
1138EOU
1139}
1140
1141sub run {
1142    my (@commands) = @_;
1143
1144    my $t0 = [gettimeofday] if opt('time');
1145    if (!opt('log')) {
1146        print interruptrun(@commands);
1147    } else {
1148        $logfh->print(interruptrun(@commands));
1149    }
1150    my $elapsed = tv_interval ( $t0 ) if opt('time');
1151    vprint -1, "r time: $elapsed" if opt('time');
1152}
1153
1154sub interruptrun {
1155    my (@commands) = @_;
1156
1157    my $command = join('', @commands);
1158    local(*FD);
1159    my $pid = open(FD, "$command |");
1160    my $text;
1161
1162    local($SIG{HUP}, $SIG{INT}) if exists $SIG{HUP};
1163    $SIG{HUP} = $SIG{INT} = sub { kill 9, $pid; exit } if exists $SIG{HUP};
1164
1165    my $needalarm =
1166          ($ENV{PERLCC_TIMEOUT} &&
1167	   exists $SIG{ALRM} &&
1168	  $Config{'osname'} ne 'MSWin32' &&
1169	  $command =~ m"(^|\s)perlcc\s");
1170
1171    eval {
1172         local($SIG{ALRM}) = sub { die "INFINITE LOOP"; } if exists $SIG{ALRM};
1173         alarm($ENV{PERLCC_TIMEOUT}) if $needalarm;
1174	 $text = join('', <FD>);
1175	 alarm(0) if $needalarm;
1176    };
1177
1178    if ($@) {
1179        eval { kill 'HUP', $pid };
1180        vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n";
1181    }
1182
1183    close(FD);
1184    return($text);
1185}
1186
1187sub is_winlike() { $^O =~ m/^(MSWin32|msys|cygwin)/ }
1188sub is_win32()   { $^O =~ m/^(MSWin32|msys)/ }
1189sub is_msvc() { is_win32 && $Config{cc} =~ m/^cl/i }
1190
1191END {
1192    if ($cfile && !opt('S') && !opt('c') && -e $cfile) {
1193        vprint 4, "Unlinking $cfile";
1194        unlink $cfile;
1195    }
1196    if (opt('staticxs') and !opt('S')) {
1197        vprint 4, "Unlinking $cfile.lst";
1198        unlink "$cfile.lst";
1199    }
1200}
1201
1202__END__
1203
1204=head1 NAME
1205
1206perlcc - generate executables from Perl programs
1207
1208=head1 SYNOPSIS
1209
1210    perlcc hello.pl            # Compiles into executable 'a.out'
1211    perlcc -o hello hello.pl   # Compiles into executable 'hello'
1212
1213    perlcc -O file.pl          # Compiles using the optimised CC backend
1214    perlcc -O3 file.pl         # Compiles with C, using -O3 optimizations
1215    perlcc -B file.pl          # Compiles using the bytecode backend
1216    perlcc -B -m file.pm       # Compiles a module to file.pmc
1217
1218    perlcc -c file.pl          # Creates a C file, 'file.c'
1219    perlcc -S -o hello file.pl # Keep C file
1220    perlcc -c out.c file.pl    # Creates a C file, 'out.c' from 'file'
1221    perlcc --staticxs -r -o hello hello.pl # Compiles,links and runs with
1222                               # XS modules static/dynaloaded
1223
1224    perlcc -e 'print q//'      # Compiles a one-liner into 'a.out'
1225    perlcc -c -e 'print q//'   # Creates a C file 'a.out.c'
1226
1227    perlcc -I /foo hello       # extra headers for C
1228    perlcc -L /foo hello       # extra libraries for C
1229    perlcc --Wb=-Dsp           # extra perl compiler options
1230    perlcc -fno-delete-pkg     # extra perl compiler options
1231    perlcc --Wc=-fno-openmp    # extra C compiler options
1232    perlcc --Wl=-s             # extra C linker options
1233
1234    perlcc -uIO::Socket        # force saving IO::Socket
1235    perlcc -UB                 # "unuse" B, compile without any B symbols
1236
1237    perlcc -r hello            # compiles 'hello' into 'a.out', runs 'a.out'
1238    perlcc -r hello a b c      # compiles 'hello' into 'a.out', runs 'a.out'
1239                               # with arguments 'a b c'
1240
1241    perlcc hello -log c.log    # compiles 'hello' into 'a.out', log into 'c.log'
1242
1243    perlcc -h       	       # help, only SYNOPSIS
1244    perlcc -v2 -h  	       # verbose help, also DESCRIPTION and OPTIONS
1245    perlcc --version  	       # prints internal perlcc and the B-C release version
1246
1247=head1 DESCRIPTION
1248
1249F<perlcc> creates standalone executables from Perl programs, using the
1250code generators provided by the L<B> module. At present, you may
1251either create executable Perl bytecode, using the C<-B> option, or
1252generate and compile C files using the standard and 'optimised' C
1253backends.
1254
1255The code generated in this way is not guaranteed to work. The whole
1256codegen suite (C<perlcc> included) should be considered B<very>
1257experimental. Use for production purposes is strongly discouraged.
1258
1259=head1 OPTIONS
1260
1261=over 4
1262
1263=item -LI<C library directories>
1264
1265Adds the given directories to the library search path when C code is
1266passed to your C compiler.
1267For multiple paths use multiple -L options.
1268
1269=item -II<C include directories>
1270
1271Adds the given directories to the include file search path when C code is
1272passed to your C compiler; when using the Perl bytecode option, adds the
1273given directories to Perl's include path.
1274For multiple paths use multiple -I options.
1275
1276=item -o I<output file name>
1277
1278Specifies the file name for the final compiled executable.
1279
1280Without given output file name we use the base of the input file,
1281or with C<-e> F<a.out> resp. F<a.exe> and a randomized intermediate
1282C filename.
1283If the input file is an absolute path on a non-windows system use
1284the basename.
1285
1286=item -c I<C file name>
1287
1288Create C file only; do not compile and link to a standalone binary.
1289
1290=item -e I<perl code>
1291
1292Compile a one-liner, much the same as C<perl -e '...'>
1293
1294=item --check
1295
1296Pass -c flag to the backend, prints all backend warnings to STDOUT
1297and exits before generating and compiling code. Similar to perl -c.
1298
1299=item --cross pathto/config.sh
1300
1301Use a different C<%B::C::Config> from another F<config.sh> for
1302cross-compilation. Passes -cross=path to the backend.
1303
1304=item -S
1305
1306"Keep source".
1307Do not delete generated C code after compilation.
1308
1309=item -B
1310
1311Use the Perl bytecode code generator.
1312
1313=item --debug or -D
1314
1315Shortcut for --Wb=-Dfull -S
1316to enable all debug levels and also preserve source code,
1317also view --Wb to enable some specific debugging options.
1318
1319=item -O
1320
1321Use the 'optimised' C code generator B::CC. This is more experimental than
1322everything else put together, and the code created is not guaranteed to
1323compile in finite time and memory, or indeed, at all.
1324
1325=item -OI<1-4>
1326
1327Pass the numeric optimisation option to the compiler backend.
1328Shortcut for C<-Wb=-On>.
1329
1330This does not enforce B::CC.
1331
1332=item -v I<0-6>
1333
1334Set verbosity of output from 0 to max. 6.
1335
1336=item -r
1337
1338Run the resulting compiled script after compiling it.
1339
1340=item --log I<logfile>
1341
1342Log the output of compiling to a file rather than to stdout.
1343
1344=item -f<option> or --f=<option>
1345
1346Pass the options to the compiler backend, such as
1347C<-fstash> or C<-fno-delete-pkg>.
1348
1349=item --Wb=I<options>
1350
1351Pass the options to the compiler backend, such as C<--Wb=-O2,-v>
1352
1353=item --Wc=I<options>
1354
1355Pass comma-seperated options to cc.
1356
1357=item --Wl=I<options>
1358
1359Pass comma-seperated options to ld.
1360
1361=item -T or -t
1362
1363run the backend using perl -T or -t
1364
1365=item -A
1366
1367Allow perl options to be passed to the executable first,
1368like -D...
1369
1370Adds C<-DALLOW_PERL_OPTIONS> which omits C<--> from being added
1371to the options handler.
1372
1373=item -u package
1374
1375Add package(s) to compiler and force linking to it.
1376
1377=item -U package
1378
1379Skip package(s). Do not compile and link the package and its sole dependencies.
1380
1381=item --stash
1382
1383Detect external packages automatically via B::Stash
1384
1385=item --static
1386
1387Link to static libperl.a
1388
1389=item --staticxs
1390
1391Link to static XS if available.
1392If the XS libs are only available as shared libs link to those ("prelink").
1393
1394Systems without rpath (windows, cygwin) must be extend LD_LIBRARY_PATH/PATH at run-time.
1395Together with -static, purely static modules and no run-time eval or
1396require this will gain no external dependencies.
1397
1398=item --shared
1399
1400Link to shared libperl
1401
1402=item --sharedxs
1403
1404Link shared XSUBs if the linker supports it. No DynaLoader needed.
1405This will still require the shared XSUB libraries to be installed
1406at the client, modification of @INC in the source is probably required.
1407(Not yet implemented)
1408
1409=item -m|--sharedlib [Modulename]
1410
1411Create a module, resp. a shared library.
1412Currently only enabled for Bytecode and CC. I<(not yet tested)>
1413
1414=item --testsuite
1415
1416Tries be nice to Test:: modules, like preallocating the file
1417handles 4 and 5, and munge the output of BEGIN.
1418
1419  perlcc -r --testsuite t/harness
1420
1421=item --time
1422
1423Benchmark the different phases B<c> I<(B::* compilation)>,
1424B<cc> I<(cc compile + link)>, and B<r> (runtime).
1425
1426=item --no-spawn
1427
1428Do not spawn subprocesses for compilation, because broken
1429shells might not be able to kill its children.
1430
1431=back
1432
1433=cut
1434
1435# Local Variables:
1436#   mode: cperl
1437#   cperl-indent-level: 4
1438#   fill-column: 100
1439# End:
1440# vim: expandtab shiftwidth=4:
1441!NO!SUBS!
1442
1443close OUT or die "Can't close $file: $!";
1444chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1445exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
1446chdir $origdir;
1447