diff options
Diffstat (limited to 'utils')
-rw-r--r-- | utils/Makefile | 21 | ||||
-rw-r--r-- | utils/perlcc.PL | 691 |
2 files changed, 3 insertions, 709 deletions
diff --git a/utils/Makefile b/utils/Makefile index 18356338cc..a37a5708ff 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -5,25 +5,12 @@ REALPERL = ../perl # Files to be built with variable substitution after miniperl is # available. Dependencies handled manually below (for now). -pl = c2ph.PL config_data.PL corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL ptar.PL ptardiff.PL shasum.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL -plextract = c2ph config_data corelist cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove ptar ptardiff shasum splain perlcc dprofpp libnetcfg piconv enc2xs xsubpp -plextractexe = ./c2ph ./config_data ./corelist ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./ptar ./ptardiff ./shasum ./splain ./perlcc ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp +pl = c2ph.PL config_data.PL corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL ptar.PL ptardiff.PL shasum.PL splain.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL +plextract = c2ph config_data corelist cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove ptar ptardiff shasum splain dprofpp libnetcfg piconv enc2xs xsubpp +plextractexe = ./c2ph ./config_data ./corelist ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./ptar ./ptardiff ./shasum ./splain ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp all: $(plextract) -compile: all $(plextract) - $(REALPERL) -I../lib perlcc -I .. -L .. c2ph -o c2ph.exe -v 10 -log ../compilelog; - $(REALPERL) -I../lib perlcc -I .. -L .. h2ph -o h2ph.exe -v 10 -log ../compilelog; - $(REALPERL) -I../lib perlcc -I .. -L .. h2xs -o h2xs.exe -v 10 -log ../compilelog; - $(REALPERL) -I../lib perlcc -I .. -L .. perlbug -o perlbug.exe -v 10 -log ../compilelog; - $(REALPERL) -I../lib perlcc -I .. -L .. perldoc -o perldoc.exe -v 10 -log ../compilelog; - $(REALPERL) -I../lib perlcc -I .. -L .. perlivp -o perlivp.exe -v 10 -log ../compilelog; - $(REALPERL) -I../lib perlcc -I .. -L .. pl2pm -o pl2pm.exe -v 10 -log ../compilelog; - $(REALPERL) -I../lib perlcc -I .. -L .. splain -o splain.exe -v 10 -log ../compilelog; - $(REALPERL) -I../lib perlcc -I .. -L .. perlcc -I .. -L .. -o perlcc.exe -v 10 -log ../compilelog; - $(REALPERL) -I../lib perlcc -I .. -L .. dprofpp -o dprofpp.exe -v 10 -log ../compilelog; - $(REALPERL) -I../lib perlcc -I .. -L .. libnetcfg -o libnetcfg.exe -v 10 -log ../compilelog; - $(plextract): $(PERL) -I../lib $@.PL @@ -59,8 +46,6 @@ shasum: shasum.PL ../config.sh splain: splain.PL ../config.sh ../lib/diagnostics.pm -perlcc: perlcc.PL ../config.sh - dprofpp: dprofpp.PL ../config.sh libnetcfg: libnetcfg.PL ../config.sh diff --git a/utils/perlcc.PL b/utils/perlcc.PL deleted file mode 100644 index 361069edf2..0000000000 --- a/utils/perlcc.PL +++ /dev/null @@ -1,691 +0,0 @@ -#!/usr/local/bin/perl - -use Config; -use File::Basename qw(&basename &dirname); -use File::Spec; -use Cwd; - -# List explicitly here the variables you want Configure to -# generate. Metaconfig only looks for shell variables, so you -# have to mention them as if they were shell variables, not -# %Config entries. Thus you write -# $startperl -# to ensure Configure will look for $Config{startperl}. -# Wanted: $archlibexp - -# This forces PL files to create target in same directory as PL file. -# This is so that make depend always knows where to find PL derivatives. -$origdir = cwd; -chdir dirname($0); -$file = basename($0, '.PL'); -$file .= '.com' if $^O eq 'VMS'; - -open OUT,">$file" or die "Can't create $file: $!"; - -print "Extracting $file (with variable substitutions)\n"; - -# In this section, perl variables will be expanded during extraction. -# You can use $Config{...} to use Configure variables. - -print OUT <<"!GROK!THIS!"; -$Config{startperl} - eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' - if \$running_under_some_shell; ---\$running_under_some_shell; -!GROK!THIS! - -# In the following, perl variables are not expanded during extraction. - -print OUT <<'!NO!SUBS!'; - -# 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 strict; -use warnings; -use 5.006_000; - -use FileHandle; -use Config; -use Fcntl qw(:DEFAULT :flock); -use File::Temp qw(tempfile); -use Cwd; -our $VERSION = 2.04; -$| = 1; - -$SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves. - -use subs qw{ - 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 -sub is_win32(); -sub is_msvc(); - -our ($Options, $BinPerl, $Backend); -our ($Input => $Output); -our ($logfh); -our ($cfile); -our (@begin_output); # output from BEGIN {}, for testsuite - -# eval { main(); 1 } or die; - -main(); - -sub main { - parse_argv(); - check_write($Output); - choose_backend(); - generate_code(); - run_code(); - _die("XXX: Not reached?"); -} - -####################################################################### - -sub choose_backend { - # Choose the backend. - $Backend = 'C'; - if (opt(B)) { - checkopts_byte(); - $Backend = 'Bytecode'; - } - if (opt(S) && opt(c)) { - # die "$0: Do you want me to compile this or not?\n"; - delete $Options->{S}; - } - $Backend = 'CC' if opt(O); -} - - -sub generate_code { - - vprint 0, "Compiling $Input"; - - $BinPerl = yclept(); # Calling convention for perl. - - if (opt(shared)) { - compile_module(); - } else { - if ($Backend eq 'Bytecode') { - compile_byte(); - } else { - compile_cstyle(); - } - } - exit(0) if (!opt('r')); -} - -sub run_code { - vprint 0, "Running code"; - run("$Output @ARGV"); - exit(0); -} - -# usage: vprint [level] msg args -sub vprint { - my $level; - if (@_ == 1) { - $level = 1; - } elsif ($_[0] =~ /^\d$/) { - $level = shift; - } else { - # well, they forgot to use a number; means >0 - $level = 0; - } - my $msg = "@_"; - $msg .= "\n" unless substr($msg, -1) eq "\n"; - if (opt(v) > $level) - { - print "$0: $msg" if !opt('log'); - print $logfh "$0: $msg" if opt('log'); - } -} - -sub parse_argv { - - use Getopt::Long; - - # 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}; - - $Options = {}; - Getopt::Long::GetOptions( $Options, - 'L:s', # lib directory - 'I:s', # include directories (FOR C, NOT FOR PERL) - 'o:s', # Output executable - 'v:i', # Verbosity level - 'e:s', # One-liner - 'r', # run resulting executable - 'B', # Byte compiler backend - 'O', # Optimised C backend - 'c', # Compile only - 'h', # Help me - 'S', # Dump C files - '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 - ); - - $Options->{v} += 0; - - if( opt(t) && opt(T) ) { - warn "Can't specify both -T and -t, -t ignored"; - $Options->{t} = 0; - } - - 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')); - - if (opt(e)) { - 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 - '-e "'.opt(e).'"' : - "-e '".opt(e)."'"; - } else { - $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; - check_read($Input); - check_perl($Input); - sanity_check(); - } - -} - -sub opt(*) { - my $opt = shift; - return exists($Options->{$opt}) && ($Options->{$opt} || 0); -} - -sub compile_module { - die "$0: Compiling to shared libraries is currently disabled\n"; -} - -sub compile_byte { - my $command = "$BinPerl -MO=Bytecode,-H,-o$Output $Input"; - $Input =~ s/^-e.*$/-e/; - - my ($output_r, $error_r) = spawnit($command); - - if (@$error_r && $? != 0) { - _die("$0: $Input did not compile:\n@$error_r\n"); - } else { - 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: $!"); - exit 0; -} - -sub compile_cstyle { - my $stash = grab_stash(); - my $taint = opt(T) ? '-T' : - opt(t) ? '-t' : ''; - - # What are we going to call our output C file? - my $lose = 0; - my ($cfh); - my $testsuite = ''; - my $addoptions = opt(Wb); - - if( $addoptions ) { - $addoptions .= ',' if $addoptions !~ m/,$/; - } - - if (opt(testsuite)) { - my $bo = join '', @begin_output; - $bo =~ s/\\/\\\\\\\\/gs; - $bo =~ s/\n/\\n/gs; - $bo =~ s/,/\\054/gs; - # don't look at that: it hurts - $testsuite = q{-fuse-script-name,-fsave-data,-fsave-sig-hash,}. - qq[-e"print q{$bo}",] . - q{-e"open(Test::Builder::TESTOUT\054 '>&STDOUT') or die $!",} . - q{-e"open(Test::Builder::TESTERR\054 '>&STDERR') or die $!",}; - } - if (opt(S) || opt(c)) { - # We need to keep it. - if (opt(e)) { - $cfile = "a.out.c"; - } else { - $cfile = $Input; - # File off extension if present - # hold on: plx is executable; also, careful of ordering! - $cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i; - $cfile .= ".c"; - $cfile = $Output if opt(c) && $Output =~ /\.c\z/i; - } - check_write($cfile); - } else { - # Don't need to keep it, be safe with a tempfile. - $lose = 1; - ($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c"); - close $cfh; # See comment just below - } - vprint 1, "Writing C on $cfile"; - - my $max_line_len = ''; - 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 - # sucks. - 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); - my @output = @$output_r; - my @error = @$error_r; - - if (@error && $? != 0) { - _die("$0: $Input did not compile, which can't happen:\n@error\n"); - } - - is_msvc ? - cc_harness_msvc($cfile,$stash) : - cc_harness($cfile,$stash) unless opt(c); - - if ($lose) { - vprint 2, "unlinking $cfile"; - unlink $cfile or _die("can't unlink $cfile: $!"); - } -} - -sub cc_harness_msvc { - my ($cfile,$stash)=@_; - use ExtUtils::Embed (); - 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"); -} - -sub cc_harness { - my ($cfile,$stash)=@_; - use ExtUtils::Embed (); - 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); - $command .= " -lperl"; - vprint 3, "running $Config{cc} $command"; - system("$Config{cc} $command"); -} - -# Where Perl is, and which include path to give it. -sub yclept { - my $command = "$^X "; - - # DWIM the -I to be Perl, not C, include directories. - if (opt(I) && $Backend eq "Bytecode") { - for (split /\s+/, opt(I)) { - if (-d $_) { - push @INC, $_; - } else { - warn "$0: Include directory $_ not found, skipping\n"; - } - } - } - - $command .= "-I$_ " for @INC; - return $command; -} - -# Use B::Stash to find additional modules and stuff. -{ - my $_stash; - sub grab_stash { - - warn "already called get_stash once" if $_stash; - - my $taint = opt(T) ? '-T' : - 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); - my @stash = @$stash_r; - my @error = @$error_r; - - if (@error && $? != 0) { - _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; - push @begin_output, $i; - } - chomp $stash[0]; - $stash[0] =~ s/,-u\<none\>//; - $stash[0] =~ s/^.*?-u/-u/s; - vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0]; - chomp $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 -sub checkopts_byte { - - _die("$0: Please choose one of either -B and -O.\n") if opt(O); - - if (opt(shared)) { - warn "$0: Will not create a shared library for bytecode\n"; - delete $Options->{shared}; - } - - for my $o ( qw[c S] ) { - if (opt($o)) { - warn "$0: Compiling to bytecode is a one-pass process--", - "-$o ignored\n"; - delete $Options->{$o}; - } - } - -} - -# Check the input and output files make sense, are read/writeable. -sub sanity_check { - if ($Input eq $Output) { - if ($Input eq 'a.out') { - _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. - } else { - warn "$0: Will not write output on top of input file, ", - "compiling to a.out instead\n"; - $Output = "a.out"; - } - } -} - -sub check_read { - my $file = shift; - unless (-r $file) { - _die("$0: Input file $file is a directory, not a file\n") if -d _; - unless (-e _) { - _die("$0: Input file $file was not found\n"); - } else { - _die("$0: Cannot read input file $file: $!\n"); - } - } - unless (-f _) { - # XXX: die? don't try this on /dev/tty - warn "$0: WARNING: input $file is not a plain file\n"; - } -} - -sub check_write { - my $file = shift; - if (-d $file) { - _die("$0: Cannot write on $file, is a directory\n"); - } - if (-e _) { - _die("$0: Cannot write on $file: $!\n") unless -w _; - } - unless (-w cwd()) { - _die("$0: Cannot write in this directory: $!\n"); - } -} - -sub check_perl { - my $file = shift; - unless (-T $file) { - warn "$0: Binary `$file' sure doesn't smell like perl source!\n"; - print "Checking file type... "; - system("file", $file); - _die("Please try a perlier file!\n"); - } - - open(my $handle, "<", $file) or _die("XXX: can't open $file: $!"); - local $_ = <$handle>; - if (/^#!/ && !/perl/) { - _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n"); - } - -} - -# File spawning and error collecting -sub spawnit { - my ($command) = shift; - my (@error,@output); - my $errname; - (undef, $errname) = tempfile("pccXXXXX"); - { - open (S_OUT, "$command 2>$errname |") - or _die("$0: Couldn't spawn the compiler.\n"); - @output = <S_OUT>; - } - open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n"); - @error = <S_ERROR>; - close S_ERROR; - close S_OUT; - unlink $errname or _die("$0: Can't unlink error file $errname"); - return (\@output, \@error); -} - -sub helpme { - print "perlcc compiler frontend, version $VERSION\n\n"; - { no warnings; - exec "pod2usage $0"; - exec "perldoc $0"; - exec "pod2text $0"; - } -} - -sub relativize { - my ($args) = @_; - - return() if ($args =~ m"^[/\\]"); - return("./$args"); -} - -sub _die { - $logfh->print(@_) if opt('log'); - print STDERR @_; - exit(); # should die eventually. However, needed so that a 'make compile' - # can compile all the way through to the end for standard dist. -} - -sub _usage_and_die { - _die(<<EOU); -$0: Usage: -$0 [-o executable] [-r] [-O|-B|-c|-S] [-I /foo] [-L /foo] [-log log] [source[.pl] | -e oneliner] -EOU -} - -sub run { - my (@commands) = @_; - - print interruptrun(@commands) if (!opt('log')); - $logfh->print(interruptrun(@commands)) if (opt('log')); -} - -sub interruptrun -{ - my (@commands) = @_; - - my $command = join('', @commands); - local(*FD); - my $pid = open(FD, "$command |"); - my $text; - - local($SIG{HUP}) = sub { kill 9, $pid; exit }; - local($SIG{INT}) = sub { kill 9, $pid; exit }; - - my $needalarm = - ($ENV{PERLCC_TIMEOUT} && - $Config{'osname'} ne 'MSWin32' && - $command =~ m"(^|\s)perlcc\s"); - - eval - { - local($SIG{ALRM}) = sub { die "INFINITE LOOP"; }; - alarm($ENV{PERLCC_TIMEOUT}) if ($needalarm); - $text = join('', <FD>); - alarm(0) if ($needalarm); - }; - - if ($@) - { - eval { kill 'HUP', $pid }; - vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n"; - } - - close(FD); - return($text); -} - -sub is_win32() { $^O =~ m/^MSWin/ } -sub is_msvc() { is_win32 && $Config{cc} =~ m/^cl/i } - -END { - unlink $cfile if ($cfile && !opt(S) && !opt(c)); -} - -__END__ - -=head1 NAME - -perlcc - generate executables from Perl programs - -=head1 SYNOPSIS - - $ 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'. - # with arguments 'a b c' - - $ perlcc hello -log c # compiles 'hello' into 'a.out' logs compile - # log into 'c'. - -=head1 DESCRIPTION - -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 -backends. - -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. - -=head1 OPTIONS - -=over 4 - -=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. - -=item -c I<C file name> - -Create C code only; do not compile to a standalone binary. - -=item -e I<perl code> - -Compile a one-liner, much the same as C<perl -e '...'> - -=item -S - -Do not delete generated C code after compilation. - -=item -B - -Use the Perl bytecode code generator. - -=item -O - -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. - -=item -v - -Increase verbosity of output; can be repeated for more verbose output. - -=item -r - -Run the resulting compiled script after compiling it. - -=item -log - -Log the output of compiling to a file rather than to stdout. - -=back - -=cut - -!NO!SUBS! - -close OUT or die "Can't close $file: $!"; -chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; -exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; -chdir $origdir; |