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
50 use Fcntl qw(:DEFAULT :flock);
51 use File::Temp qw(tempfile);
57 cc_harness check_read check_write checkopts_byte choose_backend
58 compile_byte compile_cstyle compile_module generate_code
59 grab_stash parse_argv sanity_check vprint yclept spawnit
61 sub opt(*); # imal quoting
63 our ($Options, $BinPerl, $Backend);
64 our ($Input => $Output);
66 # eval { main(); 1 } or die;
75 die "XXX: Not reached?";
79 #######################################################################
86 $Backend = 'Bytecode';
88 if (opt(S) && opt(c)) {
89 # die "$0: Do you want me to compile this or not?\n";
92 $Backend = 'CC' if opt(O);
98 vprint 0, "Compiling $Input";
100 $BinPerl = yclept(); # Calling convention for perl.
105 if ($Backend eq 'Bytecode') {
114 # usage: vprint [level] msg args
119 } elsif ($_[0] =~ /^\d$/) {
122 # well, they forgot to use a number; means >0
126 $msg .= "\n" unless substr($msg, -1) eq "\n";
127 print "$0: $msg" if opt(v) > $level;
133 Getopt::Long::Configure("bundling");
134 Getopt::Long::Configure("no_ignore_case");
136 # no difference in exists and defined for %ENV; also, a "0"
137 # argument or a "" would not help cc, so skip
138 unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
141 Getopt::Long::GetOptions( $Options,
142 'L:s', # lib directory
143 'I:s', # include directories (FOR C, NOT FOR PERL)
144 'o:s', # Output executable
145 'v+', # Verbosity level
147 'B', # Byte compiler backend
148 'O', # Optimised C backend
152 's:s', # Dirty hack to enable -shared/-static
153 'shared', # Create a shared library (--shared for compat.)
156 # This is an attempt to make perlcc's arg. handling look like cc.
157 if ( opt('s') ) { # must quote: looks like s)foo)bar)!
158 if (opt('s') eq 'hared') {
159 $Options->{shared}++;
160 } elsif (opt('s') eq 'tatic') {
161 $Options->{static}++;
163 warn "$0: Unknown option -s", opt('s');
169 helpme() if opt(h); # And exit
171 $Output = opt(o) || 'a.out';
174 warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV;
175 # We don't use a temporary file here; why bother?
176 # XXX: this is not bullet proof -- spaces or quotes in name!
177 $Input = "-e '".opt(e)."'"; # Quotes eaten by shell
179 $Input = shift @ARGV; # XXX: more files?
180 die "$0: No input file specified\n" unless $Input;
181 # DWIM modules. This is bad but necessary.
182 $Options->{shared}++ if $Input =~ /\.pm\z/;
183 warn "$0: using $Input as input file, ignoring @ARGV\n" if @ARGV;
193 return exists($Options->{$opt}) && ($Options->{$opt} || 0);
197 die "$0: Compiling to shared libraries is currently disabled\n";
202 my $stash = grab_stash();
203 my $command = "$BinPerl -MO=Bytecode,$stash $Input";
204 # The -a option means we'd have to close the file and lose the
205 # lock, which would create the tiniest of races. Instead, append
206 # the output ourselves.
207 vprint 1, "Writing on $Output";
209 my $openflags = O_WRONLY | O_CREAT;
210 $openflags |= O_BINARY if eval { O_BINARY; 1 };
211 $openflags |= O_EXLOCK if eval { O_EXLOCK; 1 };
213 # these dies are not "$0: .... \n" because they "can't happen"
215 sysopen(OUT, $Output, $openflags)
216 or die "can't write to $Output: $!";
218 # this is blocking; hold on; why are we doing this??
219 # flock OUT, LOCK_EX or die "can't lock $Output: $!"
220 # unless eval { O_EXLOCK; 1 };
223 or die "couldn't trunc $Output: $!";
227 use ByteLoader $ByteLoader::VERSION;
231 vprint 1, "Compiling...";
232 vprint 3, "Calling $command";
234 my ($output_r, $error_r) = spawnit($command);
235 my @output = @$output_r;
236 my @error = @$error_r;
238 if (@error && $? != 0) {
239 die "$0: $Input did not compile, which can't happen:\n@error\n";
242 # Write it and leave.
243 print OUT @output or die "can't write $Output: $!";
244 close OUT or die "can't close $Output: $!";
246 # wait, how could it be anything but what you see next?
247 chmod 0777 & ~umask, $Output or die "can't chmod $Output: $!";
252 my $stash = grab_stash();
254 # What are we going to call our output C file?
257 if (opt(S) || opt(c)) {
258 # We need to keep it.
263 # File off extension if present
264 # hold on: plx is executable; also, careful of ordering!
265 $cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i;
267 $cfile = $Output if opt(c) && $Output =~ /\.c\z/i;
271 # Don't need to keep it, be safe with a tempfile.
273 ($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c");
274 close $cfh; # See comment just below
276 vprint 1, "Writing C on $cfile";
278 my $max_line_len = '';
279 if ($^O eq 'MSWin32' && $Config{cc} =~ /^cl/i) {
280 $max_line_len = '-l2000,';
283 # This has to do the write itself, so we can't keep a lock. Life
285 my $command = "$BinPerl -MO=$Backend,$max_line_len$stash,-o$cfile $Input";
286 vprint 1, "Compiling...";
287 vprint 1, "Calling $command";
289 my ($output_r, $error_r) = spawnit($command);
290 my @output = @$output_r;
291 my @error = @$error_r;
293 if (@error && $? != 0) {
294 die "$0: $Input did not compile, which can't happen:\n@error\n";
297 cc_harness($cfile,$stash) unless opt(c);
300 vprint 2, "unlinking $cfile";
301 unlink $cfile or die "can't unlink $cfile: $!" if $lose;
307 my ($cfile,$stash)=@_;
308 use ExtUtils::Embed ();
309 my $command = ExtUtils::Embed::ccopts." -o $Output $cfile ";
310 $command .= join " -I", split /\s+/, opt(I);
311 $command .= join " -L", split /\s+/, opt(L);
312 my @mods = split /-?u /, $stash;
313 $command .= ExtUtils::Embed::ldopts("-std", \@mods);
314 vprint 3, "running cc $command";
315 system("cc $command");
318 # Where Perl is, and which include path to give it.
320 my $command = "$^X ";
322 # DWIM the -I to be Perl, not C, include directories.
323 if (opt(I) && $Backend eq "Bytecode") {
324 for (split /\s+/, opt(I)) {
328 warn "$0: Include directory $_ not found, skipping\n";
333 $command .= "-I$_ " for @INC;
337 # Use B::Stash to find additional modules and stuff.
342 warn "already called get_stash once" if $_stash;
344 my $command = "$BinPerl -MB::Stash -c $Input";
345 # Filename here is perfectly sanitised.
346 vprint 3, "Calling $command\n";
348 my ($stash_r, $error_r) = spawnit($command);
349 my @stash = @$stash_r;
350 my @error = @$error_r;
352 if (@error && $? != 0) {
353 die "$0: $Input did not compile:\n@error\n";
356 $stash[0] =~ s/,-u\<none\>//;
357 vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0];
359 return $_stash = $stash[0];
364 # Check the consistency of options if -B is selected.
365 # To wit, (-B|-O) ==> no -shared, no -S, no -c
368 die "$0: Please choose one of either -B and -O.\n" if opt(O);
371 warn "$0: Will not create a shared library for bytecode\n";
372 delete $Options->{shared};
375 for my $o ( qw[c S] ) {
377 warn "$0: Compiling to bytecode is a one-pass process--",
379 delete $Options->{$o};
385 # Check the input and output files make sense, are read/writeable.
387 if ($Input eq $Output) {
388 if ($Input eq 'a.out') {
389 warn "$0: Compiling a.out is probably not what you want to do.\n";
390 # You fully deserve what you get now.
392 warn "$0: Will not write output on top of input file, ",
393 "compiling to a.out instead\n";
402 die "$0: Input file $file is a directory, not a file\n" if -d _;
404 die "$0: Input file $file was not found\n";
406 die "$0: Cannot read input file $file: $!\n";
410 # XXX: die? don't try this on /dev/tty
411 warn "$0: WARNING: input $file is not a plain file\n";
418 die "$0: Cannot write on $file, is a directory\n";
421 die "$0: Cannot write on $file: $!\n" unless -w _;
424 die "$0: Cannot write in this directory: $!\n"
431 warn "$0: Binary `$file' sure doesn't smell like perl source!\n";
432 print "Checking file type... ";
433 system("file", $file);
434 die "Please try a perlier file!\n";
437 open(my $handle, "<", $file) or die "XXX: can't open $file: $!";
438 local $_ = <$handle>;
439 if (/^#!/ && !/perl/) {
440 die "$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n";
445 # File spawning and error collecting
447 my ($command) = shift;
450 (undef, $errname) = tempfile("pccXXXXX");
452 open (S_OUT, "$command 2>$errname |")
453 or die "$0: Couldn't spawn the compiler.\n";
456 open (S_ERROR, $errname) or die "$0: Couldn't read the error file.\n";
460 unlink $errname or die "$0: Can't unlink error file $errname";
461 return (\@output, \@error);
465 print "perlcc compiler frontend, version $VERSION\n\n";
478 perlcc - generate executables from Perl programs
482 $ perlcc hello # Compiles into executable 'a.out'
483 $ perlcc -o hello hello.pl # Compiles into executable 'hello'
485 $ perlcc -O file # Compiles using the optimised C backend
486 $ perlcc -B file # Compiles using the bytecode backend
488 $ perlcc -c file # Creates a C file, 'file.c'
489 $ perlcc -S -o hello file # Creates a C file, 'file.c',
490 # then compiles it to executable 'hello'
491 $ perlcc -c out.c file # Creates a C file, 'out.c' from 'file'
493 $ perlcc -e 'print q//' # Compiles a one-liner into 'a.out'
494 $ perlcc -c -e 'print q//' # Creates a C file 'a.out.c'
498 F<perlcc> creates standalone executables from Perl programs, using the
499 code generators provided by the L<B> module. At present, you may
500 either create executable Perl bytecode, using the C<-B> option, or
501 generate and compile C files using the standard and 'optimised' C
504 The code generated in this way is not guaranteed to work. The whole
505 codegen suite (C<perlcc> included) should be considered B<very>
506 experimental. Use for production purposes is strongly discouraged.
512 =item -LI<library directories>
514 Adds the given directories to the library search path when C code is
515 passed to your C compiler.
517 =item -II<include directories>
519 Adds the given directories to the include file search path when C code is
520 passed to your C compiler; when using the Perl bytecode option, adds the
521 given directories to Perl's include path.
523 =item -o I<output file name>
525 Specifies the file name for the final compiled executable.
527 =item -c I<C file name>
529 Create C code only; do not compile to a standalone binary.
531 =item -e I<perl code>
533 Compile a one-liner, much the same as C<perl -e '...'>
537 Do not delete generated C code after compilation.
541 Use the Perl bytecode code generator.
545 Use the 'optimised' C code generator. This is more experimental than
546 everything else put together, and the code created is not guaranteed to
547 compile in finite time and memory, or indeed, at all.
551 Increase verbosity of output; can be repeated for more verbose output.
559 close OUT or die "Can't close $file: $!";
560 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
561 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';