diff options
Diffstat (limited to 'utils')
-rw-r--r-- | utils/Makefile | 2 | ||||
-rw-r--r-- | utils/perlcc.PL | 186 |
2 files changed, 141 insertions, 47 deletions
diff --git a/utils/Makefile b/utils/Makefile index f3a0663bc1..944cbe8711 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -12,7 +12,7 @@ plextractexe = c2ph.exe h2ph.exe h2xs.exe perlbug.exe perldoc.exe pl2pm.exe spl all: $(plextract) compile: all - $(REALPERL) -I../lib perlcc -regex 's/$$/.exe/' $(plextract) -prog -verbose dcf -log ../compilelog; + $(REALPERL) -I../lib perlcc -opt -regex 's/$$/.exe/' $(plextract) -prog -verbose dcf -log ../compilelog; $(plextract): $(PERL) -I../lib $@.PL diff --git a/utils/perlcc.PL b/utils/perlcc.PL index 87ec16c4eb..99e9b51851 100644 --- a/utils/perlcc.PL +++ b/utils/perlcc.PL @@ -53,6 +53,7 @@ my $pathsep = ($Config{'osname'} eq 'MSWin32')? "\\" : "/"; # MAJOR HACK. SHOULD my $options = {}; my $_fh; +unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS}; main(); @@ -69,7 +70,9 @@ sub main "regex:s", "verbose:s", "log:s", - "argv:s", + "argv:s", + "b", + "opt", "gen", "sav", "run", @@ -104,33 +107,53 @@ sub _doit my ($file) = @_; my ($program_ext, $module_ext) = _getRegexps(); - my ($obj, $objfile, $so, $type); + my ($obj, $objfile, $so, $type, $backend, $gentype); + + $backend = $options->{'b'} ? 'Bytecode' : $options->{'opt'} ? 'CC' : 'C'; + + $gentype = $options->{'b'} ? 'Bytecode' : 'C'; if ( (($file =~ m"@$program_ext") && ($file !~ m"@$module_ext")) || (defined($options->{'prog'}) || defined($options->{'run'})) ) { - $objfile = ($options->{'C'}) ? $options->{'C'} : "$file.c"; $type = 'program'; - $obj = ($options->{'o'})? $options->{'o'} : - _getExecutable( $file,$program_ext); + if ($options->{'b'}) + { + $obj = $objfile = $options->{'o'} ? $options->{'o'} : "${file}c"; + } + else + { + $objfile = $options->{'C'} ? $options->{'C'} : "$file.c"; + $obj = $options->{'o'} ? $options->{'o'} + : _getExecutable( $file,$program_ext); + } return() if (!$obj); } elsif (($file =~ m"@$module_ext") || ($options->{'mod'})) { - die "Shared objects are not supported on Win32 yet!!!!\n" - if ($Config{'osname'} eq 'MSWin32'); + $type = 'module'; + + if ($options->{'b'}) + { + $obj = $objfile = $options->{'o'} ? $options->{'o'} : "${file}c"; + } + else + { + die "Shared objects are not supported on Win32 yet!!!!\n" + if ($Config{'osname'} eq 'MSWin32'); + + $objfile = $options->{'C'} ? $options->{'C'} : "$file.c"; + $obj = $options->{'o'} ? $options->{'o'} + : _getExecutable($file, $module_ext); + $so = "$obj.$Config{so}"; + } - $obj = ($options->{'o'})? $options->{'o'} : - _getExecutable($file, $module_ext); - $so = "$obj.$Config{so}"; - $type = 'sharedlib'; return() if (!$obj); - $objfile = ($options->{'C'}) ? $options->{'C'} : "$file.c"; } else { @@ -140,15 +163,17 @@ sub _doit if ($type eq 'program') { - _print("Making C($objfile) for $file!\n", 36 ); + _print("Making $gentype($objfile) for $file!\n", 36 ); - my $errcode = _createCode($objfile, $file); + my $errcode = _createCode($backend, $objfile, $file); (_print( "ERROR: In generating code for $file!\n", -1), return()) if ($errcode); - _print("Compiling C($obj) for $file!\n", 36 ) if (!$options->{'gen'}); + _print("Compiling C($obj) for $file!\n", 36 ) if (!$options->{'gen'} && + !$options->{'b'}); $errcode = _compileCode($file, $objfile, $obj) - if (!$options->{'gen'}); + if (!$options->{'gen'} && + !$options->{'b'}); if ($errcode) { @@ -160,29 +185,35 @@ sub _doit return() } - _runCode($obj) if ($options->{'run'}); + _runCode($objfile) if ($options->{'run'} && $options->{'b'}); + _runCode($obj) if ($options->{'run'} && !$options->{'b'}); - _removeCode($objfile) if (!$options->{'sav'} || - ($options->{'e'} && !$options->{'C'})); + _removeCode($objfile) if (($options->{'b'} && + ($options->{'e'} && !$options->{'o'})) || + (!$options->{'b'} && + (!$options->{'sav'} || + ($options->{'e'} && !$options->{'C'})))); _removeCode($file) if ($options->{'e'}); - _removeCode($obj) if (($options->{'e'} - && !$options->{'sav'} - && !$options->{'o'}) - || ($options->{'run'} && !$options->{'sav'})); + _removeCode($obj) if (!$options->{'b'} && + (($options->{'e'} && + !$options->{'sav'} && !$options->{'o'}) || + ($options->{'run'} && !$options->{'sav'}))); } else { - _print( "Making C($objfile) for $file!\n", 36 ); - my $errcode = _createCode($objfile, $file, $obj); + _print( "Making $gentype($objfile) for $file!\n", 36 ); + my $errcode = _createCode($backend, $objfile, $file, $obj); (_print( "ERROR: In generating code for $file!\n", -1), return()) if ($errcode); - _print( "Compiling C($so) for $file!\n", 36 ) if (!$options->{'gen'}); + _print( "Compiling C($so) for $file!\n", 36 ) if (!$options->{'gen'} && + !$options->{'b'}); - my $errorcode = - _compileCode($file, $objfile, $obj, $so ) if (!$options->{'gen'}); + $errcode = + _compileCode($file, $objfile, $obj, $so ) if (!$options->{'gen'} && + !$options->{'b'}); (_print( "ERROR: In compiling code for $objfile!\n", -1), return()) if ($errcode); @@ -219,27 +250,41 @@ sub _getExecutable sub _createCode { - my ( $generated_cfile, $file, $final_output ) = @_; + my ( $backend, $generated_file, $file, $final_output ) = @_; my $return; local($") = " -I"; - if (@_ == 2) # compiling a program + open(GENFILE, "> $generated_file") || die "Can't open $generated_file: $!"; + + if ($backend eq "Bytecode") { + require ByteLoader; + + print GENFILE "#!$^X\n" if @_ == 3; + print GENFILE "use ByteLoader $ByteLoader::VERSION;\n"; + } + + close(GENFILE); + + if (@_ == 3) # compiling a program + { + chmod $generated_file, 0777 & ~umask if $backend eq "Bytecode"; + _print( "$^X -I@INC -MB::Stash -c $file\n", 36); my $stash=`$^X -I@INC -MB::Stash -c $file 2>/dev/null|tail -1`; chomp $stash; - _print( "$^X -I@INC -MO=CC,$stash,-o$generated_cfile $file\n", 36); - $return = _run("$^X -I@INC -MO=CC,$stash,-o$generated_cfile $file", 9); + _print( "$^X -I@INC -MO=$backend,$stash $file\n", 36); + $return = _run("$^X -I@INC -MO=$backend,$stash $file >> $generated_file", 9); $return; } else # compiling a shared object { _print( - "$^X -I@INC -MO=CC,-m$final_output,-o$generated_cfile $file\n", 36); + "$^X -I@INC -MO=$backend,-m$final_output $file\n", 36); $return = - _run("$^X -I@INC -MO=CC,-m$final_output,-o$generated_cfile $file", 9); + _run("$^X -I@INC -MO=$backend,-m$final_output $file >> $generated_file", 9); $return; } } @@ -538,6 +583,21 @@ sub _checkopts $_fh = new FileHandle(">> $options->{'log'}") || push(@errors, "ERROR: Couldn't open $options->{'log'}\n"); } + if ($options->{'b'} && $options->{'c'}) + { + push(@errors, +"ERROR: The '-b' and '-c' options are incompatible. The '-c' option specifies + a name for the intermediate C code but '-b' generates byte code + directly.\n"); + } + if ($options->{'b'} && ($options->{'sav'} || $options->{'gen'})) + { + push(@errors, +"ERROR: The '-sav' and '-gen' options are incompatible with the '-b' option. + They ask for intermediate C code to be saved by '-b' generates byte + code directly.\n"); + } + if (($options->{'c'}) && (@ARGV > 1) && ($options->{'sav'} )) { push(@errors, @@ -549,17 +609,17 @@ sub _checkopts if (($options->{'o'}) && (@ARGV > 1)) { push(@errors, -"ERROR: The '-o' option is incompatible when you have more than one input file! - (-o explicitly names the resulting executable, hence, with more than +"ERROR: The '-o' option is incompatible when you have more than one input + file! (-o explicitly names the resulting file, hence, with more than one file the names clash)\n"); } - if ($options->{'e'} && $options->{'sav'} && !$options->{'o'} && + if ($options->{'e'} && ($options->{'sav'} || $options->{'gen'}) && ò0 !$options->{'C'}) { push(@errors, "ERROR: You need to specify where you are going to save the resulting - executable or C code, when using '-sav' and '-e'. Use '-o' or '-C'.\n"); + C code when using '-sav' and '-e'. Use '-C'.\n"); } if (($options->{'regex'} || $options->{'run'} || $options->{'o'}) @@ -706,7 +766,7 @@ sub _run sub _interruptrun { my ($command) = @_; - my $pid = open (FD, "$command 2>&1 |"); + my $pid = open (FD, "$command 2|"); local($SIG{HUP}) = sub { # kill 9, $pid + 1; @@ -727,14 +787,14 @@ sub _interruptrun }; my $needalarm = - ($ENV{'COMPILE_TIMEOUT'} && + ($ENV{'PERLCC_TIMEOUT'} && $Config{'osname'} ne 'MSWin32' && $command =~ m"^perlc"); my $text; eval { local($SIG{ALRM}) = sub { die "INFINITE LOOP"; }; - alarm($ENV{'COMPILE_TIMEOUT'}) if ($needalarm); + alarm($ENV{'PERLCC_TIMEOUT'}) if ($needalarm); $text = join('', <FD>); alarm(0) if ($needalarm); }; @@ -757,6 +817,9 @@ sub _usage Usage: $0 <file_list> +WARNING: The whole compiler suite ('perlcc' included) is considered VERY +experimental. Use for production purposes is strongly discouraged. + Flags with arguments -L < extra library dirs for installation (form of 'dir1:dir2') > -I < extra include dirs for installation (form of 'dir1:dir2') > @@ -768,8 +831,10 @@ Usage: $0 <file_list> -argv < arguments for the executables to be run via '-run' or '-e' > Boolean flags - -gen ( to just generate the c code. Implies '-sav' ) - -sav ( to save intermediate c code, (and executables with '-run')) + -b ( to generate byte code ) + -opt ( to generated optimised C code. May not work in some cases. ) + -gen ( to just generate the C code. Implies '-sav' ) + -sav ( to save intermediate C code, (and executables with '-run')) -run ( to run the compiled program on the fly, as were interpreted.) -prog ( to indicate that the files on command line are programs ) -mod ( to indicate that the files on command line are modules ) @@ -847,8 +912,9 @@ Adds directories inside B<include_directories> to the compilation command. =item -C < c_code_name > -Explicitly gives the name B<c_code_name> to the generated c code which is to -be compiled. Can only be used if compiling one file on the command line. +Explicitly gives the name B<c_code_name> to the generated file containing +the C code which is to be compiled. Can only be used if compiling one file +on the command line. =item -o < executable_name > @@ -863,6 +929,20 @@ in one go (see B<-run>); giving the B<-o> flag saves the resultant executable, rather than throwing it away. Use '-argv' to pass arguments to the executable created. +=item -b + +Generates bytecode instead of C code. + +=item -opt + +Uses the optimized C backend (C<B::CC>)rather than the simple C backend +(C<B::C>). Beware that the optimized C backend creates very large +switch structures and structure initializations. Many C compilers +find it a challenge to compile the resulting output in finite amounts +of time. Many Perl features such as C<goto LABEL> are also not +supported by the optimized C backend. The simple C backend should +work in more instances, but can only offer modest speed increases. + =item -regex <rename_regex> Gives a rule B<rename_regex> - which is a legal perl regular expression - to @@ -984,6 +1064,14 @@ setenv PERL_SCRIPT_EXT '\.\.\.\.\.' which would have the effect of compiling ANYTHING (except what is in PERL_MODULE_EXT) into an executable with 5 less characters in its name. +The PERLCC_OPTS environment variable can be set to the default flags +that must be used by the compiler. + +The PERLCC_TIMEOUT environment variable can be set to the number of +seconds to wait for the backends before giving up. This is sometimes +necessary to avoid some compilers taking forever to compile the +generated output. May not work on Windows and similar platforms. + =head1 FILES 'perlcc' uses a temporary file when you use the B<-e> option to evaluate @@ -995,8 +1083,14 @@ perlc$$ =head1 BUGS +The whole compiler suite (C<perlcc> included) should be considered very +experimental. Use for production purposes is strongly discouraged. + perlcc currently cannot compile shared objects on Win32. This should be fixed -by perl5.005. +in future. + +Bugs in the various compiler backends still exist, and are perhaps too +numerous to list here. =cut |