#!/import/archperf/ws/devtools/4/amd64/bin/perl
eval 'exec /import/archperf/ws/devtools/4/amd64/bin/perl -S $0 ${1+"$@"}'
if $running_under_some_shell;
--$running_under_some_shell;
# Version 2.0, Simon Cozens, Thu Mar 30 17:52:45 JST 2000
# Version 2.01, Tom Christiansen, Thu Mar 30 08:25:14 MST 2000
# Version 2.02, Simon Cozens, Sun Apr 16 01:53:36 JST 2000
# Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001
# Version 2.04, Enache Adrian,Fri, 18 Jul 2003 23:15:37 +0300
use Fcntl qw(:DEFAULT :flock);
use File::Temp qw(tempfile);
$SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves.
cc_harness check_read check_write checkopts_byte choose_backend
compile_byte compile_cstyle compile_module generate_code
grab_stash parse_argv sanity_check vprint yclept spawnit
sub opt(*); # imal quoting
our ($Options, $BinPerl, $Backend);
our (@begin_output); # output from BEGIN {}, for testsuite
# eval { main(); 1 } or die;
_die("XXX: Not reached?");
#######################################################################
# die "$0: Do you want me to compile this or not?\n";
$Backend = 'CC' if opt(O);
vprint 0, "Compiling $Input";
$BinPerl = yclept(); # Calling convention for perl.
if ($Backend eq 'Bytecode') {
vprint 0, "Running code";
# usage: vprint [level] msg args
} elsif ($_[0] =~ /^\d$/) {
# well, they forgot to use a number; means >0
$msg .= "\n" unless substr($msg, -1) eq "\n";
print "$0: $msg" if !opt('log');
print $logfh "$0: $msg" if opt('log');
# disallows using long arguments
# Getopt::Long::Configure("bundling");
Getopt::Long::Configure("no_ignore_case");
# no difference in exists and defined for %ENV; also, a "0"
# argument or a "" would not help cc, so skip
unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
Getopt::Long::GetOptions( $Options,
'I:s', # include directories (FOR C, NOT FOR PERL)
'o:s', # Output executable
'r', # run resulting executable
'B', # Byte compiler backend
'O', # Optimised C backend
'r', # run the resulting executable
'T', # run the backend using perl -T
't', # run the backend using perl -t
'static', # Dirty hack to enable -shared/-static
'shared', # Create a shared library (--shared for compat.)
'log:s', # where to log compilation process information
'Wb:s', # pass (comma-sepearated) options to backend
'testsuite', # try to be nice to testsuite
warn "Can't specify both -T and -t, -t ignored";
helpme() if opt(h); # And exit
$Output = opt(o) || ( is_win32 ? 'a.exe' : 'a.out' );
$Output = is_win32() ? $Output : relativize($Output);
$logfh = new FileHandle(">> " . opt('log')) if (opt('log'));
warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV;
# We don't use a temporary file here; why bother?
# XXX: this is not bullet proof -- spaces or quotes in name!
$Input = is_win32() ? # Quotes eaten by shell
$Input = shift @ARGV; # XXX: more files?
_usage_and_die("$0: No input file specified\n") unless $Input;
# DWIM modules. This is bad but necessary.
$Options->{shared}++ if $Input =~ /\.pm\z/;
warn "$0: using $Input as input file, ignoring @ARGV\n" if @ARGV;
return exists($Options->{$opt}) && ($Options->{$opt} || 0);
die "$0: Compiling to shared libraries is currently disabled\n";
my $command = "$BinPerl -MO=Bytecode,-H,-o$Output $Input";
my ($output_r, $error_r) = spawnit($command);
if (@$error_r && $? != 0) {
_die("$0: $Input did not compile:\n@$error_r\n");
my @error = grep { !/^$Input syntax OK$/o } @$error_r;
warn "$0: Unexpected compiler output:\n@error" if @error;
chmod 0777 & ~umask, $Output or _die("can't chmod $Output: $!");
my $stash = grab_stash();
my $taint = opt(T) ? '-T' :
# What are we going to call our output C file?
my $addoptions = opt(Wb);
$addoptions .= ',' if $addoptions !~ m/,$/;
my $bo = join '', @begin_output;
# don't look at that: it hurts
$testsuite = q{-fuse-script-name,-fsave-data,-fsave-sig-hash,}.
q{-e"open(Test::Builder::TESTOUT\054 '>&STDOUT') or die $!",} .
q{-e"open(Test::Builder::TESTERR\054 '>&STDERR') or die $!",};
# File off extension if present
# hold on: plx is executable; also, careful of ordering!
$cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i;
$cfile = $Output if opt(c) && $Output =~ /\.c\z/i;
# Don't need to keep it, be safe with a tempfile.
($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c");
close $cfh; # See comment just below
vprint 1, "Writing C on $cfile";
if ($^O eq 'MSWin32' && $Config{cc} =~ /^cl/i) {
$max_line_len = '-l2000,';
# This has to do the write itself, so we can't keep a lock. Life
my $command = "$BinPerl $taint -MO=$Backend,$addoptions$testsuite$max_line_len$stash,-o$cfile $Input";
vprint 1, "Compiling...";
vprint 1, "Calling $command";
my ($output_r, $error_r) = spawnit($command);
_die("$0: $Input did not compile, which can't happen:\n@error\n");
cc_harness_msvc($cfile,$stash) :
cc_harness($cfile,$stash) unless opt(c);
vprint 2, "unlinking $cfile";
unlink $cfile or _die("can't unlink $cfile: $!");
my $obj = "${Output}.obj";
my $compile = ExtUtils::Embed::ccopts." -c -Fo$obj $cfile ";
my $link = "-out:$Output $obj";
$compile .= " -I".$_ for split /\s+/, opt(I);
$link .= " -libpath:".$_ for split /\s+/, opt(L);
my @mods = split /-?u /, $stash;
$link .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
$link .= " perl5$Config{PERL_VERSION}.lib kernel32.lib msvcrt.lib";
vprint 3, "running $Config{cc} $compile";
system("$Config{cc} $compile");
vprint 3, "running $Config{ld} $link";
system("$Config{ld} $link");
my $command = ExtUtils::Embed::ccopts." -o $Output $cfile ";
$command .= " -I".$_ for split /\s+/, opt(I);
$command .= " -L".$_ for split /\s+/, opt(L);
my @mods = split /-?u /, $stash;
$command .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
vprint 3, "running $Config{cc} $command";
system("$Config{cc} $command");
# Where Perl is, and which include path to give it.
# DWIM the -I to be Perl, not C, include directories.
if (opt(I) && $Backend eq "Bytecode") {
for (split /\s+/, opt(I)) {
warn "$0: Include directory $_ not found, skipping\n";
$command .= "-I$_ " for @INC;
# Use B::Stash to find additional modules and stuff.
warn "already called get_stash once" if $_stash;
my $taint = opt(T) ? '-T' :
my $command = "$BinPerl $taint -MB::Stash -c $Input";
# Filename here is perfectly sanitised.
vprint 3, "Calling $command\n";
my ($stash_r, $error_r) = spawnit($command);
_die("$0: $Input did not compile:\n@error\n");
# band-aid for modules with noisy BEGIN {}
foreach my $i ( @stash ) {
$i =~ m/-u(?:[\w:]+|\<none\>)$/ and $stash[0] = $i and next;
$stash[0] =~ s/,-u\<none\>//;
$stash[0] =~ s/^.*?-u/-u/s;
vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0];
return $_stash = $stash[0];
# Check the consistency of options if -B is selected.
# To wit, (-B|-O) ==> no -shared, no -S, no -c
_die("$0: Please choose one of either -B and -O.\n") if opt(O);
warn "$0: Will not create a shared library for bytecode\n";
delete $Options->{shared};
warn "$0: Compiling to bytecode is a one-pass process--",
# Check the input and output files make sense, are read/writeable.
_die("$0: Compiling a.out is probably not what you want to do.\n");
# You fully deserve what you get now. No you *don't*. typos happen.
warn "$0: Will not write output on top of input file, ",
"compiling to a.out instead\n";
_die("$0: Input file $file is a directory, not a file\n") if -d _;
_die("$0: Input file $file was not found\n");
_die("$0: Cannot read input file $file: $!\n");
# XXX: die? don't try this on /dev/tty
warn "$0: WARNING: input $file is not a plain file\n";
_die("$0: Cannot write on $file, is a directory\n");
_die("$0: Cannot write on $file: $!\n") unless -w _;
_die("$0: Cannot write in this directory: $!\n");
warn "$0: Binary `$file' sure doesn't smell like perl source!\n";
print "Checking file type... ";
_die("Please try a perlier file!\n");
open(my $handle, "<", $file) or _die("XXX: can't open $file: $!");
_die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n");
# File spawning and error collecting
(undef, $errname) = tempfile("pccXXXXX");
open (S_OUT, "$command 2>$errname |")
or _die("$0: Couldn't spawn the compiler.\n");
open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n");
unlink $errname or _die("$0: Can't unlink error file $errname");
return (\@output, \@error);
print "perlcc compiler frontend, version $VERSION\n\n";
return() if ($args =~ m"^[/\\]");
$logfh->print(@_) if opt('log');
exit(); # should die eventually. However, needed so that a 'make compile'
# can compile all the way through to the end for standard dist.
$0 [-o executable] [-r] [-O|-B|-c|-S] [-I /foo] [-L /foo] [-log log] [source[.pl] | -e oneliner]
print interruptrun(@commands) if (!opt('log'));
$logfh->print(interruptrun(@commands)) if (opt('log'));
my $command = join('', @commands);
my $pid = open(FD, "$command |");
local($SIG{HUP}) = sub { kill 9, $pid; exit };
local($SIG{INT}) = sub { kill 9, $pid; exit };
$Config{'osname'} ne 'MSWin32' &&
$command =~ m"(^|\s)perlcc\s");
local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
alarm($ENV{PERLCC_TIMEOUT}) if ($needalarm);
alarm(0) if ($needalarm);
eval { kill 'HUP', $pid };
vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n";
sub is_win32() { $^O =~ m/^MSWin/ }
sub is_msvc() { is_win32 && $Config{cc} =~ m/^cl/i }
unlink $cfile if ($cfile && !opt(S) && !opt(c));
perlcc - generate executables from Perl programs
$ perlcc hello # Compiles into executable 'a.out'
$ perlcc -o hello hello.pl # Compiles into executable 'hello'
$ perlcc -O file # Compiles using the optimised C backend
$ perlcc -B file # Compiles using the bytecode backend
$ perlcc -c file # Creates a C file, 'file.c'
$ perlcc -S -o hello file # Creates a C file, 'file.c',
# then compiles it to executable 'hello'
$ perlcc -c out.c file # Creates a C file, 'out.c' from 'file'
$ perlcc -e 'print q//' # Compiles a one-liner into 'a.out'
$ perlcc -c -e 'print q//' # Creates a C file 'a.out.c'
$ perlcc -I /foo hello # extra headers (notice the space after -I)
$ perlcc -L /foo hello # extra libraries (notice the space after -L)
$ perlcc -r hello # compiles 'hello' into 'a.out', runs 'a.out'.
$ perlcc -r hello a b c # compiles 'hello' into 'a.out', runs 'a.out'.
$ perlcc hello -log c # compiles 'hello' into 'a.out' logs compile
F<perlcc> creates standalone executables from Perl programs, using the
code generators provided by the L<B> module. At present, you may
either create executable Perl bytecode, using the C<-B> option, or
generate and compile C files using the standard and 'optimised' C
The code generated in this way is not guaranteed to work. The whole
codegen suite (C<perlcc> included) should be considered B<very>
experimental. Use for production purposes is strongly discouraged.
=item -LI<library directories>
Adds the given directories to the library search path when C code is
passed to your C compiler.
=item -II<include directories>
Adds the given directories to the include file search path when C code is
passed to your C compiler; when using the Perl bytecode option, adds the
given directories to Perl's include path.
=item -o I<output file name>
Specifies the file name for the final compiled executable.
Create C code only; do not compile to a standalone binary.
Compile a one-liner, much the same as C<perl -e '...'>
Do not delete generated C code after compilation.
Use the Perl bytecode code generator.
Use the 'optimised' C code generator. This is more experimental than
everything else put together, and the code created is not guaranteed to
compile in finite time and memory, or indeed, at all.
Increase verbosity of output; can be repeated for more verbose output.
Run the resulting compiled script after compiling it.
Log the output of compiling to a file rather than to stdout.