4 use File::Basename qw(&basename &dirname);
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
13 # to ensure Configure will look for $Config{startperl}.
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.
20 $file = basename($0, '.PL');
21 $file .= '.com' if $^O eq 'VMS';
23 open OUT,">$file" or die "Can't create $file: $!";
25 print "Extracting $file (with variable substitutions)\n";
27 # In this section, perl variables will be expanded during extraction.
28 # You can use $Config{...} to use Configure variables.
30 print OUT <<"!GROK!THIS!";
32 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
33 if \$running_under_some_shell;
34 --\$running_under_some_shell;
37 # In the following, perl variables are not expanded during extraction.
39 print OUT <<'!NO!SUBS!';
41 # Version 2.0, Simon Cozens, Thu Mar 30 17:52:45 JST 2000
42 # Version 2.01, Tom Christiansen, Thu Mar 30 08:25:14 MST 2000
43 # Version 2.02, Simon Cozens, Sun Apr 16 01:53:36 JST 2000
44 # Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001
52 use Fcntl qw(:DEFAULT :flock);
53 use File::Temp qw(tempfile);
58 $SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves.
61 cc_harness check_read check_write checkopts_byte choose_backend
62 compile_byte compile_cstyle compile_module generate_code
63 grab_stash parse_argv sanity_check vprint yclept spawnit
65 sub opt(*); # imal quoting
69 our ($Options, $BinPerl, $Backend);
70 our ($Input => $Output);
73 our (@begin_output); # output from BEGIN {}, for testsuite
75 # eval { main(); 1 } or die;
85 _die("XXX: Not reached?");
88 #######################################################################
95 $Backend = 'Bytecode';
97 if (opt(S) && opt(c)) {
98 # die "$0: Do you want me to compile this or not?\n";
101 $Backend = 'CC' if opt(O);
107 vprint 0, "Compiling $Input";
109 $BinPerl = yclept(); # Calling convention for perl.
114 if ($Backend eq 'Bytecode') {
120 exit(0) if (!opt('r'));
124 vprint 0, "Running code";
125 run("$Output @ARGV");
129 # usage: vprint [level] msg args
134 } elsif ($_[0] =~ /^\d$/) {
137 # well, they forgot to use a number; means >0
141 $msg .= "\n" unless substr($msg, -1) eq "\n";
144 print "$0: $msg" if !opt('log');
145 print $logfh "$0: $msg" if opt('log');
153 # disallows using long arguments
154 # Getopt::Long::Configure("bundling");
156 Getopt::Long::Configure("no_ignore_case");
158 # no difference in exists and defined for %ENV; also, a "0"
159 # argument or a "" would not help cc, so skip
160 unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
163 Getopt::Long::GetOptions( $Options,
164 'L:s', # lib directory
165 'I:s', # include directories (FOR C, NOT FOR PERL)
166 'o:s', # Output executable
167 'v:i', # Verbosity level
169 'r', # run resulting executable
170 'B', # Byte compiler backend
171 'O', # Optimised C backend
175 'r', # run the resulting executable
176 'T', # run the backend using perl -T
177 't', # run the backend using perl -t
178 'static', # Dirty hack to enable -shared/-static
179 'shared', # Create a shared library (--shared for compat.)
180 'log:s', # where to log compilation process information
181 'testsuite', # try to be nice to testsuite
186 if( opt(t) && opt(T) ) {
187 warn "Can't specify both -T and -t, -t ignored";
191 helpme() if opt(h); # And exit
193 $Output = opt(o) || ( is_win32 ? 'a.exe' : 'a.out' );
194 $Output = is_win32() ? $Output : relativize($Output);
195 $logfh = new FileHandle(">> " . opt('log')) if (opt('log'));
198 warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV;
199 # We don't use a temporary file here; why bother?
200 # XXX: this is not bullet proof -- spaces or quotes in name!
201 $Input = is_win32() ? # Quotes eaten by shell
205 $Input = shift @ARGV; # XXX: more files?
206 _usage_and_die("$0: No input file specified\n") unless $Input;
207 # DWIM modules. This is bad but necessary.
208 $Options->{shared}++ if $Input =~ /\.pm\z/;
209 warn "$0: using $Input as input file, ignoring @ARGV\n" if @ARGV;
219 return exists($Options->{$opt}) && ($Options->{$opt} || 0);
223 die "$0: Compiling to shared libraries is currently disabled\n";
228 my $stash = grab_stash();
229 my $command = "$BinPerl -MO=Bytecode,$stash $Input";
230 # The -a option means we'd have to close the file and lose the
231 # lock, which would create the tiniest of races. Instead, append
232 # the output ourselves.
233 vprint 1, "Writing on $Output";
235 my $openflags = O_WRONLY | O_CREAT;
236 $openflags |= O_BINARY if eval { O_BINARY; 1 };
237 $openflags |= O_EXLOCK if eval { O_EXLOCK; 1 };
239 # these dies are not "$0: .... \n" because they "can't happen"
241 sysopen(OUT, $Output, $openflags)
242 or die "can't write to $Output: $!";
244 # this is blocking; hold on; why are we doing this??
245 # flock OUT, LOCK_EX or die "can't lock $Output: $!"
246 # unless eval { O_EXLOCK; 1 };
249 or die "couldn't trunc $Output: $!";
253 use ByteLoader $ByteLoader::VERSION;
257 vprint 1, "Compiling...";
258 vprint 3, "Calling $command";
260 my ($output_r, $error_r) = spawnit($command);
262 if (@$error_r && $? != 0) {
263 _die("$0: $Input did not compile, which can't happen:\n@$error_r\n");
265 my @error = grep { !/^$Input syntax OK$/o } @$error_r;
266 warn "$0: Unexpected compiler output:\n@error" if @error;
269 # Write it and leave.
270 print OUT @$output_r or _die("can't write $Output: $!");
271 close OUT or _die("can't close $Output: $!");
273 # wait, how could it be anything but what you see next?
274 chmod 0777 & ~umask, $Output or _die("can't chmod $Output: $!");
279 my $stash = grab_stash();
280 my $taint = opt(T) ? '-T' :
283 # What are we going to call our output C file?
288 if (opt(testsuite)) {
289 my $bo = join '', @begin_output;
290 $bo =~ s/\\/\\\\\\\\/gs;
293 # don't look at that: it hurts
294 $testsuite = q{-fuse-script-name,-fsave-data,-fsave-sig-hash,}.
295 qq[-e"print q{$bo}",] .
296 q{-e"open(Test::Builder::TESTOUT\054 '>&STDOUT') or die $!",} .
297 q{-e"open(Test::Builder::TESTERR\054 '>&STDERR') or die $!",};
299 if (opt(S) || opt(c)) {
300 # We need to keep it.
305 # File off extension if present
306 # hold on: plx is executable; also, careful of ordering!
307 $cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i;
309 $cfile = $Output if opt(c) && $Output =~ /\.c\z/i;
313 # Don't need to keep it, be safe with a tempfile.
315 ($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c");
316 close $cfh; # See comment just below
318 vprint 1, "Writing C on $cfile";
320 my $max_line_len = '';
321 if ($^O eq 'MSWin32' && $Config{cc} =~ /^cl/i) {
322 $max_line_len = '-l2000,';
325 # This has to do the write itself, so we can't keep a lock. Life
327 my $command = "$BinPerl $taint -MO=$Backend,$testsuite$max_line_len$stash,-o$cfile $Input";
328 vprint 1, "Compiling...";
329 vprint 1, "Calling $command";
331 my ($output_r, $error_r) = spawnit($command);
332 my @output = @$output_r;
333 my @error = @$error_r;
335 if (@error && $? != 0) {
336 _die("$0: $Input did not compile, which can't happen:\n@error\n");
340 cc_harness_msvc($cfile,$stash) :
341 cc_harness($cfile,$stash) unless opt(c);
344 vprint 2, "unlinking $cfile";
345 unlink $cfile or _die("can't unlink $cfile: $!");
349 sub cc_harness_msvc {
350 my ($cfile,$stash)=@_;
351 use ExtUtils::Embed ();
352 my $obj = "${Output}.obj";
353 my $compile = ExtUtils::Embed::ccopts." -c -Fo$obj $cfile ";
354 my $link = "-out:$Output $obj";
355 $compile .= " -I".$_ for split /\s+/, opt(I);
356 $link .= " -libpath:".$_ for split /\s+/, opt(L);
357 my @mods = split /-?u /, $stash;
358 $link .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
359 $link .= " perl57.lib msvcrt.lib";
360 vprint 3, "running $Config{cc} $compile";
361 system("$Config{cc} $compile");
362 vprint 3, "running $Config{ld} $link";
363 system("$Config{ld} $link");
367 my ($cfile,$stash)=@_;
368 use ExtUtils::Embed ();
369 my $command = ExtUtils::Embed::ccopts." -o $Output $cfile ";
370 $command .= " -I".$_ for split /\s+/, opt(I);
371 $command .= " -L".$_ for split /\s+/, opt(L);
372 my @mods = split /-?u /, $stash;
373 $command .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
374 $command .= " -lperl";
375 vprint 3, "running $Config{cc} $command";
376 system("$Config{cc} $command");
379 # Where Perl is, and which include path to give it.
381 my $command = "$^X ";
383 # DWIM the -I to be Perl, not C, include directories.
384 if (opt(I) && $Backend eq "Bytecode") {
385 for (split /\s+/, opt(I)) {
389 warn "$0: Include directory $_ not found, skipping\n";
394 $command .= "-I$_ " for @INC;
398 # Use B::Stash to find additional modules and stuff.
403 warn "already called get_stash once" if $_stash;
405 my $taint = opt(T) ? '-T' :
407 my $command = "$BinPerl $taint -MB::Stash -c $Input";
408 # Filename here is perfectly sanitised.
409 vprint 3, "Calling $command\n";
411 my ($stash_r, $error_r) = spawnit($command);
412 my @stash = @$stash_r;
413 my @error = @$error_r;
415 if (@error && $? != 0) {
416 _die("$0: $Input did not compile:\n@error\n");
419 # band-aid for modules with noisy BEGIN {}
420 foreach my $i ( @stash ) {
421 $i =~ m/-u(?:[\w:]+|\<none\>)$/ and $stash[0] = $i and next;
422 push @begin_output, $i;
425 $stash[0] =~ s/,-u\<none\>//;
426 $stash[0] =~ s/^.*?-u/-u/s;
427 vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0];
429 return $_stash = $stash[0];
434 # Check the consistency of options if -B is selected.
435 # To wit, (-B|-O) ==> no -shared, no -S, no -c
438 _die("$0: Please choose one of either -B and -O.\n") if opt(O);
441 warn "$0: Will not create a shared library for bytecode\n";
442 delete $Options->{shared};
445 for my $o ( qw[c S] ) {
447 warn "$0: Compiling to bytecode is a one-pass process--",
449 delete $Options->{$o};
455 # Check the input and output files make sense, are read/writeable.
457 if ($Input eq $Output) {
458 if ($Input eq 'a.out') {
459 _die("$0: Compiling a.out is probably not what you want to do.\n");
460 # You fully deserve what you get now. No you *don't*. typos happen.
462 warn "$0: Will not write output on top of input file, ",
463 "compiling to a.out instead\n";
472 _die("$0: Input file $file is a directory, not a file\n") if -d _;
474 _die("$0: Input file $file was not found\n");
476 _die("$0: Cannot read input file $file: $!\n");
480 # XXX: die? don't try this on /dev/tty
481 warn "$0: WARNING: input $file is not a plain file\n";
488 _die("$0: Cannot write on $file, is a directory\n");
491 _die("$0: Cannot write on $file: $!\n") unless -w _;
494 _die("$0: Cannot write in this directory: $!\n");
501 warn "$0: Binary `$file' sure doesn't smell like perl source!\n";
502 print "Checking file type... ";
503 system("file", $file);
504 _die("Please try a perlier file!\n");
507 open(my $handle, "<", $file) or _die("XXX: can't open $file: $!");
508 local $_ = <$handle>;
509 if (/^#!/ && !/perl/) {
510 _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n");
515 # File spawning and error collecting
517 my ($command) = shift;
520 (undef, $errname) = tempfile("pccXXXXX");
522 open (S_OUT, "$command 2>$errname |")
523 or _die("$0: Couldn't spawn the compiler.\n");
526 open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n");
530 unlink $errname or _die("$0: Can't unlink error file $errname");
531 return (\@output, \@error);
535 print "perlcc compiler frontend, version $VERSION\n\n";
546 return() if ($args =~ m"^[/\\]");
551 $logfh->print(@_) if opt('log');
553 exit(); # should die eventually. However, needed so that a 'make compile'
554 # can compile all the way through to the end for standard dist.
560 $0 [-o executable] [-r] [-O|-B|-c|-S] [-log log] [source[.pl] | -e oneliner]
567 print interruptrun(@commands) if (!opt('log'));
568 $logfh->print(interruptrun(@commands)) if (opt('log'));
575 my $command = join('', @commands);
577 my $pid = open(FD, "$command |");
580 local($SIG{HUP}) = sub { kill 9, $pid; exit };
581 local($SIG{INT}) = sub { kill 9, $pid; exit };
584 ($ENV{PERLCC_TIMEOUT} &&
585 $Config{'osname'} ne 'MSWin32' &&
586 $command =~ m"(^|\s)perlcc\s");
590 local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
591 alarm($ENV{PERLCC_TIMEOUT}) if ($needalarm);
592 $text = join('', <FD>);
593 alarm(0) if ($needalarm);
598 eval { kill 'HUP', $pid };
599 vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n";
606 sub is_win32() { $^O =~ m/^MSWin/ }
607 sub is_msvc() { is_win32 && $Config{cc} =~ m/^cl/i }
610 unlink $cfile if ($cfile && !opt(S) && !opt(c));
617 perlcc - generate executables from Perl programs
621 $ perlcc hello # Compiles into executable 'a.out'
622 $ perlcc -o hello hello.pl # Compiles into executable 'hello'
624 $ perlcc -O file # Compiles using the optimised C backend
625 $ perlcc -B file # Compiles using the bytecode backend
627 $ perlcc -c file # Creates a C file, 'file.c'
628 $ perlcc -S -o hello file # Creates a C file, 'file.c',
629 # then compiles it to executable 'hello'
630 $ perlcc -c out.c file # Creates a C file, 'out.c' from 'file'
632 $ perlcc -e 'print q//' # Compiles a one-liner into 'a.out'
633 $ perlcc -c -e 'print q//' # Creates a C file 'a.out.c'
635 $ perlcc -I /foo hello # extra headers (notice the space after -I)
636 $ perlcc -L /foo hello # extra libraries (notice the space after -L)
638 $ perlcc -r hello # compiles 'hello' into 'a.out', runs 'a.out'.
639 $ perlcc -r hello a b c # compiles 'hello' into 'a.out', runs 'a.out'.
640 # with arguments 'a b c'
642 $ perlcc hello -log c # compiles 'hello' into 'a.out' logs compile
647 F<perlcc> creates standalone executables from Perl programs, using the
648 code generators provided by the L<B> module. At present, you may
649 either create executable Perl bytecode, using the C<-B> option, or
650 generate and compile C files using the standard and 'optimised' C
653 The code generated in this way is not guaranteed to work. The whole
654 codegen suite (C<perlcc> included) should be considered B<very>
655 experimental. Use for production purposes is strongly discouraged.
661 =item -LI<library directories>
663 Adds the given directories to the library search path when C code is
664 passed to your C compiler.
666 =item -II<include directories>
668 Adds the given directories to the include file search path when C code is
669 passed to your C compiler; when using the Perl bytecode option, adds the
670 given directories to Perl's include path.
672 =item -o I<output file name>
674 Specifies the file name for the final compiled executable.
676 =item -c I<C file name>
678 Create C code only; do not compile to a standalone binary.
680 =item -e I<perl code>
682 Compile a one-liner, much the same as C<perl -e '...'>
686 Do not delete generated C code after compilation.
690 Use the Perl bytecode code generator.
694 Use the 'optimised' C code generator. This is more experimental than
695 everything else put together, and the code created is not guaranteed to
696 compile in finite time and memory, or indeed, at all.
700 Increase verbosity of output; can be repeated for more verbose output.
704 Run the resulting compiled script after compiling it.
708 Log the output of compiling to a file rather than to stdout.
716 close OUT or die "Can't close $file: $!";
717 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
718 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';