From: Gurusamy Sarathy Date: Mon, 6 Sep 1999 20:16:58 +0000 (+0000) Subject: support bytecode and C backends in perlcc (patch suggested X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9636a016720fa29929de1fb9fc4ead4cfbfc4af8;p=p5sagit%2Fp5-mst-13.2.git support bytecode and C backends in perlcc (patch suggested by Tom Hughes ); s/-opt/-noopt/ and make the C backend the default; describe new switches in pod; introduce PERLCC_OPTS and s/COMPILE_TIMEOUT/PERLCC_TIMEOUT/; s/COMPILE_TEST/HARNESS_COMPILE_TEST/; document these %ENV entries p4raw-id: //depot/perl@4092 --- diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm index a9e5d55..5694531 100644 --- a/ext/B/B/Bytecode.pm +++ b/ext/B/B/Bytecode.pm @@ -392,7 +392,8 @@ sub B::PVIV::bytecode { } sub B::PVNV::bytecode { - my ($sv, $flag) = @_; + my $sv = shift; + my $flag = shift || 0; # The $flag argument is passed through PVMG::bytecode by BM::bytecode # and AV::bytecode and indicates special handling. $flag = 1 is used by # BM::bytecode and means that we should ensure we save the whole B-M diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index db3109a..a469cfa 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -87,9 +87,10 @@ sub runtests { $s .= join " ", q[ "-T"], map {qq["-I$_"]} @INC if $first =~ /^#!.*\bperl.*-\w*T/; $fh->close or print "can't close $test. $!\n"; - my $cmd = ($ENV{'COMPILE_TEST'})? -"./perl -I../lib ../utils/perlcc $test -run 2>> ./compilelog |" - : "$^X $s $test|"; + my $cmd = ($ENV{'HARNESS_COMPILE_TEST'}) + ? "./perl -I../lib ../utils/perlcc $test " + . "-run 2>> ./compilelog |" + : "$^X $s $test|"; $cmd = "MCR $cmd" if $^O eq 'VMS'; $fh->open($cmd) or print "can't run $test. $!\n"; $ok = $next = $max = 0; @@ -484,6 +485,9 @@ harness to output more frequent progress messages using carriage returns. Some consoles may not handle carriage returns properly (which results in a somewhat messy output). +Setting C to a true value will make harness attempt +to compile the test using C before running it. + If C is set to the name of a directory, harness will check after each test whether new files appeared in that directory, and report them as diff --git a/t/TEST b/t/TEST index 69cf0c6..1f9190d 100755 --- a/t/TEST +++ b/t/TEST @@ -43,8 +43,8 @@ TESTING COMPILER -------------------------------------------------------------------------------- EOT - $ENV{COMPILE_TIMEOUT} = 120 - if ($type eq 'compile' && !$ENV{COMPILE_TIMEOUT}); + $ENV{PERLCC_TIMEOUT} = 120 + if ($type eq 'compile' && !$ENV{PERLCC_TIMEOUT}); $bad = 0; $good = 0; diff --git a/t/UTEST b/t/UTEST index 2850f76..b5f285b 100755 --- a/t/UTEST +++ b/t/UTEST @@ -55,8 +55,8 @@ TESTING COMPILER -------------------------------------------------------------------------------- EOT - $ENV{COMPILE_TIMEOUT} = 120 - if ($type eq 'compile' && !$ENV{COMPILE_TIMEOUT}); + $ENV{PERLCC_TIMEOUT} = 120 + if ($type eq 'compile' && !$ENV{PERLCC_TIMEOUT}); $bad = 0; $good = 0; diff --git a/t/harness b/t/harness index b89b35a..e1a4dd7 100644 --- a/t/harness +++ b/t/harness @@ -72,8 +72,8 @@ EOT print "The tests ", join(' ', keys(%infinite)), " generate infinite loops! Skipping!\n"; -$ENV{'COMPILE_TEST'} = 1; -$ENV{'COMPILE_TIMEOUT'} = 120 unless $ENV{'COMPILE_TIMEOUT'}; +$ENV{'HARNESS_COMPILE_TEST'} = 1; +$ENV{'PERLCC_TIMEOUT'} = 120 unless $ENV{'PERLCC_TIMEOUT'}; Test::Harness::runtests @tests; foreach (keys %datahandle) { diff --git a/utils/Makefile b/utils/Makefile index f3a0663..944cbe8 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 87ec16c..99e9b51 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('', ); alarm(0) if ($needalarm); }; @@ -757,6 +817,9 @@ sub _usage Usage: $0 +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 -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 to the compilation command. =item -C < c_code_name > -Explicitly gives the name B 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 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)rather than the simple C backend +(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 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 Gives a rule B - 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 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