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
# 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';
use strict;
use FileHandle;
use File::Basename qw(&basename &dirname);
+use Cwd;
use Getopt::Long;
$Getopt::Long::passthrough = 0;
$Getopt::Long::ignore_case = 0;
+my $pathsep = ($Config{'osname'} eq 'MSWin32')? "\\" : "/"; # MAJOR HACK. SHOULD
+ # BE IN Config.pm
+
my $options = {};
my $_fh;
+unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
main();
"regex:s",
"verbose:s",
"log:s",
- "argv:s",
+ "argv:s",
+ "b",
+ "opt",
"gen",
"sav",
"run",
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.so";
- $type = 'sharedlib';
return() if (!$obj);
}
else
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'});
- my $errcode = _compileCode($file, $objfile, $obj)
- if (!$options->{'gen'});
+ _print("Compiling C($obj) for $file!\n", 36 ) if (!$options->{'gen'} &&
+ !$options->{'b'});
+ $errcode = _compileCode($file, $objfile, $obj)
+ if (!$options->{'gen'} &&
+ !$options->{'b'});
if ($errcode)
{
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($obj) 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);
($obj = $sourceprog) =~ s"@$ext"$options->{ext}"g;
return(0) if (_error('equal', $obj, $sourceprog));
}
- elsif (defined ($options->{'run'}))
- {
- $obj = "perlc$$";
- }
+ elsif (defined ($options->{'run'}))
+ {
+ $obj = "perlc$$";
+ }
else
{
($obj = $sourceprog) =~ s"@$ext""g;
sub _createCode
{
- my ( $generated_cfile, $file, $final_output ) = @_;
+ my ( $backend, $generated_file, $file, $final_output ) = @_;
my $return;
+ my $output_switch = "o";
local($") = " -I";
- if (@_ == 2) # compiling a program
+ if ($backend eq "Bytecode")
{
- _print( "$^X -I@INC -MO=CC,-o$generated_cfile $file\n", 36);
- $return = _run("$\18 -I@INC -MO=CC,-o$generated_cfile $file", 9);
+ require ByteLoader;
+
+ open(GENFILE, "> $generated_file") || die "Can't open $generated_file: $!";
+ binmode GENFILE;
+ print GENFILE "#!$^X\n" if @_ == 3;
+ print GENFILE "use ByteLoader $ByteLoader::VERSION;\n";
+ close(GENFILE);
+
+ $output_switch ="a";
+ }
+
+ if (@_ == 3) # compiling a program
+ {
+ chmod $generated_file, 0777 & ~umask if $backend eq "Bytecode";
+ my $null=File::Spec->devnull;
+ _print( "$^X -I@INC -MB::Stash -c $file\n", 36);
+ my @stash=`$^X -I@INC -MB::Stash -c $file 2>$null`;
+ my $stash=$stash[-1];
+ chomp $stash;
+
+ _print( "$^X -I@INC -MO=$backend,$stash $file\n", 36);
+ $return = _run("$^X -I@INC -MO=$backend,$stash,-$output_switch$generated_file $file", 9);
$return;
}
else # compiling a shared object
{
_print(
- "$\18 -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("$\18 -I@INC -MO=CC,-m$final_output,-o$generated_cfile $file", 9);
+ _run("$^X -I@INC -MO=$backend,-m$final_output,-$output_switch$generated_file $file ", 9);
$return;
}
}
if (@_ == 3) # just compiling a program
{
$return[0] =
- _ccharness($sourceprog, "-o", $output_executable, $generated_cfile);
+ _ccharness('static', $sourceprog, "-o", $output_executable,
+ $generated_cfile);
$return[0];
}
else
{
my $object_file = $generated_cfile;
- $object_file =~ s"\.c$"\.o";
+ $object_file =~ s"\.c$"$Config{_o}";
- $return[0] = _ccharness($sourceprog, "-c", $generated_cfile);
+ $return[0] = _ccharness('compile', $sourceprog, "-c", $generated_cfile);
$return[1] = _ccharness
(
- $sourceprog, "-shared","-o",
+ 'dynamic',
+ $sourceprog, "-o",
$shared_object, $object_file
);
return(1) if (grep ($_, @return));
sub _ccharness
{
+ my $type = shift;
my (@args) = @_;
local($") = " ";
}
else
{
- $libdir = "-L..";
- $incdir = "-I..";
+ $libdir = "-L.. -L.";
+ $incdir = "-I.. -I.";
}
$libdir .= " -L$options->{L}" if (defined($options->{L}));
$incdir .= " -I$options->{L}" if (defined($options->{L}));
- my $linkargs;
+ my $linkargs = '';
+ my $dynaloader = '';
+ my $optimize = '';
+ my $flags = '';
- if (!grep(/^-[cS]$/, @ARGV))
+ if (!grep(/^-[cS]$/, @args))
{
- $linkargs = sprintf("%s $libdir -lperl %s",@Config{qw(ldflags libs)});
- }
+ my $lperl = $^O eq 'os2' ? '-llibperl'
+ : $^O eq 'MSWin32' ? "$Config{archlibexp}\\CORE\\perl.lib"
+ : '-lperl';
- my @sharedobjects = _getSharedObjects($sourceprog);
+ $optimize = $Config{'optimize'} =~ /-O\d/ ? '' : $Config{'optimize'};
- my $cccmd =
- "$Config{cc} $Config{ccflags} $incdir @sharedobjects @args $linkargs";
+ $flags = $type eq 'dynamic' ? $Config{lddlflags} : $Config{ldflags};
+ $linkargs = "$flags $libdir $lperl @Config{libs}";
+ }
+ my $libs = _getSharedObjects($sourceprog);
+
+ my $ccflags = $Config{ccflags};
+ $ccflags .= ' -DUSEIMPORTLIB' if $Config{osname} =~ /cygwin/i;
+ my $cccmd = "$Config{cc} $ccflags $optimize $incdir "
+ ."@args $dynaloader $linkargs @$libs";
_print ("$cccmd\n", 36);
_run("$cccmd", 18 );
{
my ($sourceprog) = @_;
my ($tmpfile, $incfile);
- my (@return);
+ my (@sharedobjects, @libraries);
local($") = " -I";
- if ($Config{'osname'} eq 'MSWin32')
- {
- # _addstuff;
- }
- else
- {
- my ($tmpprog);
- ($tmpprog = $sourceprog) =~ s"(.*)[\/\\](.*)"$2";
- $tmpfile = "/tmp/$tmpprog.tst";
- $incfile = "/tmp/$tmpprog.val";
- }
+ my ($tmpprog);
+ ($tmpprog = $sourceprog) =~ s"(.*)[\\/](.*)"$2";
+
+ my $tempdir= File::Spec->tmpdir;
+
+ $tmpfile = "$tempdir/$tmpprog.tst";
+ $incfile = "$tempdir/$tmpprog.val";
my $fd = new FileHandle("> $tmpfile") || die "Couldn't open $tmpfile!\n";
my $fd2 =
new FileHandle("$sourceprog") || die "Couldn't open $sourceprog!\n";
- my $perl = <$fd2>; # strip off header;
-
- print $fd
-<<"EOF";
+ print $fd <<"EOF";
use FileHandle;
my \$fh3 = new FileHandle("> $incfile")
|| die "Couldn't open $incfile\\n";
print $fd ( <$fd2> );
close($fd);
- _print("$\18 -I@INC $tmpfile\n", 36);
- _run("$\18 -I@INC $tmpfile", 9 );
+ _print("$^X -I@INC $tmpfile\n", 36);
+ _run("$^X -I@INC $tmpfile", 9 );
- my $fd = new FileHandle ("$incfile");
+ $fd = new FileHandle ("$incfile");
my @lines = <$fd>;
unlink($tmpfile);
my $line;
my $autolib;
+ my @return;
+
foreach $line (@lines)
{
chomp($line);
+
my ($modname, $modpath) = split(':', $line);
my ($dir, $file) = ($modpath=~ m"(.*)[\\/]($modname)");
-
- if ($autolib = _lookforAuto($dir, $file))
- {
- push(@return, $autolib);
- }
- }
- return(@return);
+ if ($autolib = _lookforAuto($dir, $file)) { push(@return, $autolib); }
+ }
+ return(\@return);
}
sub _maketempfile
{
my ($dir, $file) = @_;
- my $relshared;
+ my ($relabs, $relshared);
+ my ($prefix);
my $return;
+ my $sharedextension = $^O =~ /MSWin32|cygwin|os2/i
+ ? $Config{_a} : ".$Config{so}";
+ ($prefix = $file) =~ s"(.*)\.pm"$1";
- ($relshared = $file) =~ s"(.*)\.pm"$1";
+ my ($tmp, $modname) = ($prefix =~ m"(?:(.*)[\\/]){0,1}(.*)"s);
- my ($tmp, $modname) = ($relshared =~ m"(?:(.*)[\\/]){0,1}(.*)"s);
+ $relshared = "$pathsep$prefix$pathsep$modname$sharedextension";
+ $relabs = "$pathsep$prefix$pathsep$modname$Config{_a}";
+ # HACK . WHY DOES _a HAVE A '.'
+ # AND so HAVE NONE??
- $relshared .=
- ($Config{'osname'} eq 'MSWin32')? "\\$modname.dll" : "/$modname.so";
+ my @searchpaths = map("$_${pathsep}auto", @INC);
-
-
- if (-e ($return = "$Config{'installarchlib'}/auto/$relshared") )
- {
- return($return);
- }
- elsif (-e ($return = "$Config{'installsitearch'}/auto/$relshared"))
- {
- return($return);
- }
- elsif (-e ($return = "$dir/arch/auto/$relshared"))
- {
- return($return);
- }
- else
+ my $path;
+ foreach $path (@searchpaths)
{
- return(undef);
+ if (-e ($return = "$path$relshared")) { return($return); }
+ if (-e ($return = "$path$relabs")) { return($return); }
}
+ return(undef);
}
sub _getRegexps # make the appropriate regexps for making executables,
@$module_ext = ($ENV{PERL_MODULE_EXT})? split(':', $ENV{PERL_MODULE_EXT}) :
('.pm$');
-
_mungeRegexp( $program_ext );
_mungeRegexp( $module_ext );
{
my ($regexp) = @_;
- grep(s"(^|[^\\])\."$1\x0\\."g, @$regexp);
- grep(s"(^|[^\x0])\\\."$1\."g, @$regexp);
- grep(s"\x0""g, @$regexp);
+ grep(s:(^|[^\\])\.:$1\x00\\.:g, @$regexp);
+ grep(s:(^|[^\x00])\\\.:$1\.:g, @$regexp);
+ grep(s:\x00::g, @$regexp);
}
-
sub _error
{
my ($type, @args) = @_;
$_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,
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'}) &&
!$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'})
my $doreg = (($regflag & $options->{'verbose'}) || $flag == -1);
if ($doreg && !$dolog)
- { system("$command"); }
-
+ {
+ print _interruptrun("$command");
+ }
elsif ($doreg && $dolog)
- { my $text = `$command 2>&1`; print $_fh $text; print STDERR $text;}
+ {
+ my $text = _interruptrun($command);
+ print $_fh $text;
+ print STDERR $text;
+ }
else
- { my $text = `$command 2>&1`; print $_fh $text; }
+ {
+ my $text = _interruptrun($command);
+ print $_fh $text;
+ }
}
else
{
- `$command 2>&1`;
+ _interruptrun($command);
}
return($?);
}
+sub _interruptrun
+{
+ my ($command) = @_;
+ my $pid = open (FD, "$command |");
+
+ local($SIG{HUP}) = sub {
+# kill 9, $pid + 1;
+# HACK... 2>&1 doesn't propogate
+# kill, comment out for quick and dirty
+# process killing of child.
+
+ kill 9, $pid;
+ exit();
+ };
+ local($SIG{INT}) = sub {
+# kill 9, $pid + 1;
+# HACK... 2>&1 doesn't propogate
+# kill, comment out for quick and dirty
+# process killing of child.
+ kill 9, $pid;
+ exit();
+ };
+
+ my $needalarm =
+ ($ENV{'PERLCC_TIMEOUT'} &&
+ $Config{'osname'} ne 'MSWin32' && $command =~ m"^perlc");
+ my $text;
+
+ 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; };
+ _print("SYSTEM TIMEOUT (infinite loop?)\n", 36);
+ }
+
+ close(FD);
+ return($text);
+}
+
sub _usage
{
_print
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') >
-o < explicit name of resulting executable >
-e < to compile 'one liners'. Need executable name (-o) or '-run'>
-regex < rename regex, -regex 's/\.p/\.exe/' compiles a.p to a.exe >
- -verbose < verbose level (1-63, or following letters 'gatfcd' >
+ -verbose < verbose level < 1-63, or following letters 'gatfcd' >
-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 )
=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 >
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
=item -verbose <verbose_level>
-Show exactly what steps perlcc is taking to compile your code. You can change
-the verbosity level B<verbose_level> much in the same way that the '-D' switch
-changes perl's debugging level, by giving either a number which is the sum of
-bits you want or a list of letters representing what you wish to see. Here are
-the verbosity levels so far :
+Show exactly what steps perlcc is taking to compile your code. You can
+change the verbosity level B<verbose_level> much in the same way that
+the C<-D> switch changes perl's debugging level, by giving either a
+number which is the sum of bits you want or a list of letters
+representing what you wish to see. Here are the verbosity levels so
+far :
Bit 1(g): Code Generation Errors to STDERR
Bit 2(a): Compilation Errors to STDERR
=item -argv <arguments>
-In combination with '-run' or '-e', tells perlcc to run the resulting
+In combination with C<-run> or C<-e>, tells perlcc to run the resulting
executable with the string B<arguments> as @ARGV.
=item -sav
Tells perl to save the intermediate C code. Usually, this C code is the name
of the perl code, plus '.c'; 'perlcode.p' gets generated in 'perlcode.p.c',
-for example. If used with the '-e' operator, you need to tell perlcc where to
+for example. If used with the C<-e> operator, you need to tell perlcc where to
save resulting executables.
=item -gen
.pm$
indicate a library, for the purposes of creating executables. And furthermore,
-by default, these extensions will be replaced (and dropped ) in the process of
+by default, these extensions will be replaced (and dropped) in the process of
creating an executable.
To change the extensions which are programs, and which are modules, set the
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
=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
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;
projects / p5sagit/p5-mst-13.2.git / blobdiff