Bytecode.pm revision 7c478bd95313f5f23a4c958a745db2134aa03244
# B::Bytecode.pm
# Copyright (c) 2003 Enache Adrian. All rights reserved.
# it under the same terms as Perl itself.
# Based on the original Bytecode.pm module written by Malcolm Beattie.
package B::Bytecode;
our $VERSION = '1.01';
use strict;
use Config;
use B::Asmdata qw(@specialsv_name);
#################################################
my $tix = 1;
sub asm;
sub nice ($) { }
BEGIN {
eval qq{
sub VERSION() { $] }
}; die $@ if $@;
}
#################################################
sub pvstring {
my $pv = shift;
}
sub pvix {
$tix++;
}
}
my $op = shift;
$ix;
}
}
my $spec = shift;
}
}
my $sv = shift;
$ix;
}
}
nice "[GV]";
return $ix
# XXX {{{{
# }}}} XXX
nice "-GV-",
} else {
nice "[GV]";
}
$ix;
}
}
my $hv = shift;
if ($name) {
nice "[STASH]";
# my $pmrootix = $hv->PMROOT->ix; # XXX
# asm "xhv_pmroot", $pmrootix; # XXX
} else {
nice "[HV]";
next if $i = not $i;
$_ = $_->ix;
}
nice "-HV-",
for @array;
}
$ix;
}
}
my $sv = shift;
}
#################################################
}
}
asm "xpv";
}
}
}
}
}
nice '-MAGICAL-';
for (@mglist) {
}
for (@mglist) {
} elsif ($length) {
asm "mg_name";
}
}
}
}
}
}
# asm "xio_flags", ord($io->IoFLAGS) & ~32; # XXX XXX
}
}
}
nice "-AV-",
}
my $gv = shift;
}
my $hv = shift;
while (my($k,$v) = each %stash) {
}
} else {
nice "[prototype]";
}
}
}
######################################################
sub B::OP::bsave_thin {
}
}
my $firstix =
# that's just neat
# trick for /$a/o in pp_regcomp
|| $name eq 'rv2sv'
# change #18774 made my life hard
: 0;
}
my $lastix = do {
};
} else {
}
}
# not needed if no pseudohashes
# deal with sort / formline
} elsif ($name eq 'formline') {
} else {
}
}
# fat versions
# asm "op_seq", -1; XXX don't allocate OPs piece by piece
}
}
}
}
}
# my $pmnextix = $op->pmnext->ix; # XXX
if (ITHREADS) {
$rrop = "op_pmreplroot";
$rrop = "op_pmreplrootpo";
}
} else {
$rrop = "op_pmreplrootgv";
}
# asm "op_pmnext", $pmnextix; # XXX
asm "pregcomp";
}
}
}
} else {
asm "op_pv";
}
}
}
if (ITHREADS) {
} else {
}
}
my $op = shift;
my $ix;
push @cloop, undef;
while ($_ = pop @cloop) {
}
$ix;
}
}
#################################################
sub save_cq {
my $av;
if ($savebegins) {
next unless $_->FILE eq $0;
}
} else {
next unless $_->FILE eq $0;
# XXX BEGIN { goto A while 1; A: }
# this kludge needed for tests
};
last;
}
}
}
}
next unless $_->FILE eq $0;
}
}
next unless $_->FILE eq $0;
}
}
}
sub compile {
my $cwd = '';
sub keep_syn {
$keep_syn = 1;
}
for (@_) {
if (/^-S/) {
*asm = sub { print " @_\n" };
*nice = sub ($) { print "\n@_\n" };
} elsif (/^-H/) {
require ByteLoader;
$head = "#! $^X\nuse ByteLoader $ByteLoader::VERSION;\n";
} elsif (/^-k/) {
} elsif (/^-o(.*)$/) {
} elsif (/^-f(.*)$/) {
} elsif (/^-s(.*)$/) {
} elsif (/^-b/) {
$savebegins = 1;
# this is here for the testsuite
} elsif (/^-TI/) {
$T_inhinc = 1;
} elsif (/^-TF(.*)/) {
my $thatfile = $1;
} else {
bwarn "Ignoring '$_' option";
}
}
if ($scan) {
my $f;
if (open $f, $scan) {
while (<$f>) {
/^#\s*line\s+\d+\s+("?)(.*)\1/ and $files{$2} = 1;
/^#/ and next;
bwarn "keeping the syntax tree: \"goto\" op found";
}
}
} else {
bwarn "cannot rescan '$scan'";
}
close $f;
}
binmode STDOUT;
return sub {
newasm sub { print @_ };
{
no strict 'refs';
nice "<DATA>";
unless (eof $dh) {
local undef $/;
print <$dh>;
} else {
asm "ret";
}
}
}
}
1;
=head1 NAME
B::Bytecode - Perl compiler's bytecode backend
=head1 SYNOPSIS
=head1 DESCRIPTION
Compiles a Perl script into a bytecode format that could be loaded
later by the ByteLoader module and executed as a regular Perl script.
=head1 EXAMPLE
$ perl -MO=Bytecode,-H,-ohi -e 'print "hi!\n"'
$ perl hi
hi!
=head1 OPTIONS
=over 4
=item B<-b>
Save all the BEGIN blocks. Normally only BEGIN blocks that C<require>
other files (ex. C<use Foo;>) are saved.
=item B<-H>
prepend a C<use ByteLoader VERSION;> line to the produced bytecode.
=item B<-k>
keep the syntax tree - it is stripped by default.
=item B<-o>I<outfile>
put the bytecode in <outfile> instead of dumping it to STDOUT.
=item B<-s>
scan the script for C<# line ..> directives and for <goto LABEL>
expressions. When gotos are found keep the syntax tree.
=back
=head1 KNOWN BUGS
=over 4
=item *
C<BEGIN { goto A: while 1; A: }> won't even compile.
=item *
C<?...?> and C<reset> do not work as expected.
=item *
variables in C<(?{ ... })> constructs are not properly scoped.
=item *
scripts that use source filters will fail miserably.
=back
=head1 NOTICE
There are also undocumented bugs and options.
THIS CODE IS HIGHLY EXPERIMENTAL. USE AT YOUR OWN RISK.
=head1 AUTHORS
Originally written by Malcolm Beattie <mbeattie@sable.ox.ac.uk> and
modified by Benjamin Stuhl <sho_pi@hotmail.com>.
Rewritten by Enache Adrian <enache@rdslink.ro>, 2003 a.d.
=cut