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 'Wb:s', # pass (comma-sepearated) options to backend
182 'testsuite', # try to be nice to testsuite
187 if( opt(t) && opt(T) ) {
188 warn "Can't specify both -T and -t, -t ignored";
192 helpme() if opt(h); # And exit
194 $Output = opt(o) || ( is_win32 ? 'a.exe' : 'a.out' );
195 $Output = is_win32() ? $Output : relativize($Output);
196 $logfh = new FileHandle(">> " . opt('log')) if (opt('log'));
199 warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV;
200 # We don't use a temporary file here; why bother?
201 # XXX: this is not bullet proof -- spaces or quotes in name!
202 $Input = is_win32() ? # Quotes eaten by shell
206 $Input = shift @ARGV; # XXX: more files?
207 _usage_and_die("$0: No input file specified\n") unless $Input;
208 # DWIM modules. This is bad but necessary.
209 $Options->{shared}++ if $Input =~ /\.pm\z/;
210 warn "$0: using $Input as input file, ignoring @ARGV\n" if @ARGV;
220 return exists($Options->{$opt}) && ($Options->{$opt} || 0);
224 die "$0: Compiling to shared libraries is currently disabled\n";
229 my $stash = grab_stash();
230 my $command = "$BinPerl -MO=Bytecode,$stash $Input";
231 # The -a option means we'd have to close the file and lose the
232 # lock, which would create the tiniest of races. Instead, append
233 # the output ourselves.
234 vprint 1, "Writing on $Output";
236 my $openflags = O_WRONLY | O_CREAT;
237 $openflags |= O_BINARY if eval { O_BINARY; 1 };
238 $openflags |= O_EXLOCK if eval { O_EXLOCK; 1 };
240 # these dies are not "$0: .... \n" because they "can't happen"
242 sysopen(OUT, $Output, $openflags)
243 or die "can't write to $Output: $!";
245 # this is blocking; hold on; why are we doing this??
246 # flock OUT, LOCK_EX or die "can't lock $Output: $!"
247 # unless eval { O_EXLOCK; 1 };
250 or die "couldn't trunc $Output: $!";
254 use ByteLoader $ByteLoader::VERSION;
258 vprint 1, "Compiling...";
259 vprint 3, "Calling $command";
261 my ($output_r, $error_r) = spawnit($command);
263 if (@$error_r && $? != 0) {
264 _die("$0: $Input did not compile, which can't happen:\n@$error_r\n");
266 my @error = grep { !/^$Input syntax OK$/o } @$error_r;
267 warn "$0: Unexpected compiler output:\n@error" if @error;
270 # Write it and leave.
271 print OUT @$output_r or _die("can't write $Output: $!");
272 close OUT or _die("can't close $Output: $!");
274 # wait, how could it be anything but what you see next?
275 chmod 0777 & ~umask, $Output or _die("can't chmod $Output: $!");
280 my $stash = grab_stash();
281 my $taint = opt(T) ? '-T' :
284 # What are we going to call our output C file?
288 my $addoptions = opt(Wb);
291 $addoptions .= ',' if $addoptions !~ m/,$/;
294 if (opt(testsuite)) {
295 my $bo = join '', @begin_output;
296 $bo =~ s/\\/\\\\\\\\/gs;
299 # don't look at that: it hurts
300 $testsuite = q{-fuse-script-name,-fsave-data,-fsave-sig-hash,}.
301 qq[-e"print q{$bo}",] .
302 q{-e"open(Test::Builder::TESTOUT\054 '>&STDOUT') or die $!",} .
303 q{-e"open(Test::Builder::TESTERR\054 '>&STDERR') or die $!",};
305 if (opt(S) || opt(c)) {
306 # We need to keep it.
311 # File off extension if present
312 # hold on: plx is executable; also, careful of ordering!
313 $cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i;
315 $cfile = $Output if opt(c) && $Output =~ /\.c\z/i;
319 # Don't need to keep it, be safe with a tempfile.
321 ($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c");
322 close $cfh; # See comment just below
324 vprint 1, "Writing C on $cfile";
326 my $max_line_len = '';
327 if ($^O eq 'MSWin32' && $Config{cc} =~ /^cl/i) {
328 $max_line_len = '-l2000,';
331 # This has to do the write itself, so we can't keep a lock. Life
333 my $command = "$BinPerl $taint -MO=$Backend,$addoptions$testsuite$max_line_len$stash,-o$cfile $Input";
334 vprint 1, "Compiling...";
335 vprint 1, "Calling $command";
337 my ($output_r, $error_r) = spawnit($command);
338 my @output = @$output_r;
339 my @error = @$error_r;
341 if (@error && $? != 0) {
342 _die("$0: $Input did not compile, which can't happen:\n@error\n");
346 cc_harness_msvc($cfile,$stash) :
347 cc_harness($cfile,$stash) unless opt(c);
350 vprint 2, "unlinking $cfile";
351 unlink $cfile or _die("can't unlink $cfile: $!");
355 sub cc_harness_msvc {
356 my ($cfile,$stash)=@_;
357 use ExtUtils::Embed ();
358 my $obj = "${Output}.obj";
359 my $compile = ExtUtils::Embed::ccopts." -c -Fo$obj $cfile ";
360 my $link = "-out:$Output $obj";
361 $compile .= " -I".$_ for split /\s+/, opt(I);
362 $link .= " -libpath:".$_ for split /\s+/, opt(L);
363 my @mods = split /-?u /, $stash;
364 $link .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
365 $link .= " perl57.lib kernel32.lib msvcrt.lib";
366 vprint 3, "running $Config{cc} $compile";
367 system("$Config{cc} $compile");
368 vprint 3, "running $Config{ld} $link";
369 system("$Config{ld} $link");
373 my ($cfile,$stash)=@_;
374 use ExtUtils::Embed ();
375 my $command = ExtUtils::Embed::ccopts." -o $Output $cfile ";
376 $command .= " -I".$_ for split /\s+/, opt(I);
377 $command .= " -L".$_ for split /\s+/, opt(L);
378 my @mods = split /-?u /, $stash;
379 $command .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
380 $command .= " -lperl";
381 vprint 3, "running $Config{cc} $command";
382 system("$Config{cc} $command");
385 # Where Perl is, and which include path to give it.
387 my $command = "$^X ";
389 # DWIM the -I to be Perl, not C, include directories.
390 if (opt(I) && $Backend eq "Bytecode") {
391 for (split /\s+/, opt(I)) {
395 warn "$0: Include directory $_ not found, skipping\n";
400 $command .= "-I$_ " for @INC;
404 # Use B::Stash to find additional modules and stuff.
409 warn "already called get_stash once" if $_stash;
411 my $taint = opt(T) ? '-T' :
413 my $command = "$BinPerl $taint -MB::Stash -c $Input";
414 # Filename here is perfectly sanitised.
415 vprint 3, "Calling $command\n";
417 my ($stash_r, $error_r) = spawnit($command);
418 my @stash = @$stash_r;
419 my @error = @$error_r;
421 if (@error && $? != 0) {
422 _die("$0: $Input did not compile:\n@error\n");
425 # band-aid for modules with noisy BEGIN {}
426 foreach my $i ( @stash ) {
427 $i =~ m/-u(?:[\w:]+|\<none\>)$/ and $stash[0] = $i and next;
428 push @begin_output, $i;
431 $stash[0] =~ s/,-u\<none\>//;
432 $stash[0] =~ s/^.*?-u/-u/s;
433 vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0];
435 return $_stash = $stash[0];
440 # Check the consistency of options if -B is selected.
441 # To wit, (-B|-O) ==> no -shared, no -S, no -c
444 _die("$0: Please choose one of either -B and -O.\n") if opt(O);
447 warn "$0: Will not create a shared library for bytecode\n";
448 delete $Options->{shared};
451 for my $o ( qw[c S] ) {
453 warn "$0: Compiling to bytecode is a one-pass process--",
455 delete $Options->{$o};
461 # Check the input and output files make sense, are read/writeable.
463 if ($Input eq $Output) {
464 if ($Input eq 'a.out') {
465 _die("$0: Compiling a.out is probably not what you want to do.\n");
466 # You fully deserve what you get now. No you *don't*. typos happen.
468 warn "$0: Will not write output on top of input file, ",
469 "compiling to a.out instead\n";
478 _die("$0: Input file $file is a directory, not a file\n") if -d _;
480 _die("$0: Input file $file was not found\n");
482 _die("$0: Cannot read input file $file: $!\n");
486 # XXX: die? don't try this on /dev/tty
487 warn "$0: WARNING: input $file is not a plain file\n";
494 _die("$0: Cannot write on $file, is a directory\n");
497 _die("$0: Cannot write on $file: $!\n") unless -w _;
500 _die("$0: Cannot write in this directory: $!\n");
507 warn "$0: Binary `$file' sure doesn't smell like perl source!\n";
508 print "Checking file type... ";
509 system("file", $file);
510 _die("Please try a perlier file!\n");
513 open(my $handle, "<", $file) or _die("XXX: can't open $file: $!");
514 local $_ = <$handle>;
515 if (/^#!/ && !/perl/) {
516 _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n");
521 # File spawning and error collecting
523 my ($command) = shift;
526 (undef, $errname) = tempfile("pccXXXXX");
528 open (S_OUT, "$command 2>$errname |")
529 or _die("$0: Couldn't spawn the compiler.\n");
532 open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n");
536 unlink $errname or _die("$0: Can't unlink error file $errname");
537 return (\@output, \@error);
541 print "perlcc compiler frontend, version $VERSION\n\n";
552 return() if ($args =~ m"^[/\\]");
557 $logfh->print(@_) if opt('log');
559 exit(); # should die eventually. However, needed so that a 'make compile'
560 # can compile all the way through to the end for standard dist.
566 $0 [-o executable] [-r] [-O|-B|-c|-S] [-log log] [source[.pl] | -e oneliner]
573 print interruptrun(@commands) if (!opt('log'));
574 $logfh->print(interruptrun(@commands)) if (opt('log'));
581 my $command = join('', @commands);
583 my $pid = open(FD, "$command |");
586 local($SIG{HUP}) = sub { kill 9, $pid; exit };
587 local($SIG{INT}) = sub { kill 9, $pid; exit };
590 ($ENV{PERLCC_TIMEOUT} &&
591 $Config{'osname'} ne 'MSWin32' &&
592 $command =~ m"(^|\s)perlcc\s");
596 local($SIG{ALRM}) = sub { die "INFINITE LOOP"; };
597 alarm($ENV{PERLCC_TIMEOUT}) if ($needalarm);
598 $text = join('', <FD>);
599 alarm(0) if ($needalarm);
604 eval { kill 'HUP', $pid };
605 vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n";
612 sub is_win32() { $^O =~ m/^MSWin/ }
613 sub is_msvc() { is_win32 && $Config{cc} =~ m/^cl/i }
616 unlink $cfile if ($cfile && !opt(S) && !opt(c));
623 perlcc - generate executables from Perl programs
627 $ perlcc hello # Compiles into executable 'a.out'
628 $ perlcc -o hello hello.pl # Compiles into executable 'hello'
630 $ perlcc -O file # Compiles using the optimised C backend
631 $ perlcc -B file # Compiles using the bytecode backend
633 $ perlcc -c file # Creates a C file, 'file.c'
634 $ perlcc -S -o hello file # Creates a C file, 'file.c',
635 # then compiles it to executable 'hello'
636 $ perlcc -c out.c file # Creates a C file, 'out.c' from 'file'
638 $ perlcc -e 'print q//' # Compiles a one-liner into 'a.out'
639 $ perlcc -c -e 'print q//' # Creates a C file 'a.out.c'
641 $ perlcc -I /foo hello # extra headers (notice the space after -I)
642 $ perlcc -L /foo hello # extra libraries (notice the space after -L)
644 $ perlcc -r hello # compiles 'hello' into 'a.out', runs 'a.out'.
645 $ perlcc -r hello a b c # compiles 'hello' into 'a.out', runs 'a.out'.
646 # with arguments 'a b c'
648 $ perlcc hello -log c # compiles 'hello' into 'a.out' logs compile
653 F<perlcc> creates standalone executables from Perl programs, using the
654 code generators provided by the L<B> module. At present, you may
655 either create executable Perl bytecode, using the C<-B> option, or
656 generate and compile C files using the standard and 'optimised' C
659 The code generated in this way is not guaranteed to work. The whole
660 codegen suite (C<perlcc> included) should be considered B<very>
661 experimental. Use for production purposes is strongly discouraged.
667 =item -LI<library directories>
669 Adds the given directories to the library search path when C code is
670 passed to your C compiler.
672 =item -II<include directories>
674 Adds the given directories to the include file search path when C code is
675 passed to your C compiler; when using the Perl bytecode option, adds the
676 given directories to Perl's include path.
678 =item -o I<output file name>
680 Specifies the file name for the final compiled executable.
682 =item -c I<C file name>
684 Create C code only; do not compile to a standalone binary.
686 =item -e I<perl code>
688 Compile a one-liner, much the same as C<perl -e '...'>
692 Do not delete generated C code after compilation.
696 Use the Perl bytecode code generator.
700 Use the 'optimised' C code generator. This is more experimental than
701 everything else put together, and the code created is not guaranteed to
702 compile in finite time and memory, or indeed, at all.
706 Increase verbosity of output; can be repeated for more verbose output.
710 Run the resulting compiled script after compiling it.
714 Log the output of compiling to a file rather than to stdout.
722 close OUT or die "Can't close $file: $!";
723 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
724 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';