Bytecode.pm revision 7c478bd95313f5f23a4c958a745db2134aa03244
#
# Copyright (c) 1996-1998 Malcolm Beattie
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
#
package B::Bytecode;
use strict;
use Carp;
);
my %optype_enum;
my $i;
for ($i = 0; $i < @optype; $i++) {
$optype_enum{$optype[$i]} = $i;
}
# Following is SVf_POK|SVp_POK
# XXX Shouldn't be hardwired
# Following is SVf_IOK|SVp_IOK
# XXX Shouldn't be hardwired
# Following is SVf_NOK|SVp_NOK
# XXX Shouldn't be hardwired
# nonexistant flags (see B::GV::bytecode for usage)
sub GVf_IMPORTED_IO () { 0; }
sub GVf_IMPORTED_FORM () { 0; }
my @packages; # list of packages to compile
sub asm (@) { # print replacement that knows about assembling
if ($no_assemble) {
print @_;
} else {
my $buf = join '', @_;
}
}
sub asmf (@) { # printf replacement that knows about assembling
if ($no_assemble) {
printf shift(), @_;
} else {
my $format = shift;
}
}
# Optimisation options. On the command line, use hyphens instead of
# underscores for compatibility with gcc-style options. We use
# underscores here because they are OK in (strict) barewords.
bypass_nullops => \$bypass_nullops);
my $strip_syntree; # this is left here in case stripping the
# syntree ever becomes safe again
# -- BKS, June 2000
my $nextix = 0;
my %symtable; # maps object addresses to object indices.
my %saved; # maps object addresses (for SVish classes) to "saved yet?"
# flag. Set at FOO::bytecode time usually by SV::bytecode.
# Manipulated via saved(), mark_saved(), unmark_saved().
my %strtable; # maps shared strings to object indices
# Filled in at allocation (pvix) time
# of the object table to avoid unnecessary repeated
# consecutive ldsv instructions.
sub ldsv {
my $ix = shift;
asm "ldsv $ix\n";
}
}
sub stsv {
my $ix = shift;
asm "stsv $ix\n";
}
sub set_svix {
$svix = shift;
}
sub ldop {
my $ix = shift;
asm "ldop $ix\n";
}
}
sub stop {
my $ix = shift;
asm "stop $ix\n";
}
sub set_opix {
$opix = shift;
}
sub pvstring {
my $str = shift;
if (defined($str)) {
} else {
return '""';
}
}
sub nv {
# print full precision
$str =~ s/\.$/.0/;
return $str;
}
sub pvix { # save a shared PV (mainly for COPs)
return $ix;
}
my $obj = shift;
warn sprintf("bytecode save method for %s (0x%x) not yet implemented\n",
}
#
# objix may stomp on the op register (for op objects)
# or the sv register (for SV objects)
#
my $obj = shift;
if (defined($ix)) {
return $ix;
} else {
}
}
}
asm "gv_fetchpv $name\n";
}
if ($name) {
# It's a stash
} else {
# It's an ordinary HV. Fall back to ordinary newix method
}
}
# Special case. $$sv is not the address of the SV but an
# index into svspecialsv_list.
}
croak("OP::newix: can't understand class $class") unless defined($typenum);
asm "newop $typenum\t# $class\n";
}
sub B::OP::walkoptree_debug {
my $op = shift;
}
my $op = shift;
my $nextix;
if ($bypass_nullops) {
}
asm "op_next $nextix\n";
if ($type || !$compress_nullops) {
asmf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n",
}
}
my $op = shift;
asm "op_first $firstix\n";
}
}
my $op = shift;
asm "op_other $otherix\n";
}
my $op = shift;
asm "op_sv $svix\n";
}
my $op = shift;
asm "op_padix $padix\n";
}
my $op = shift;
#
# This would be easy except that OP_TRANS uses a PVOP to store an
# endian-dependent array of 256 shorts instead of a plain string.
#
} else {
}
}
my $op = shift;
asm "op_last $lastix\n";
}
}
my $op = shift;
asm "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n";
}
my $op = shift;
if ($debug_bc) { # do this early to aid debugging
}
cop_label %d
cop_stashpv %d
cop_seq %d
cop_file %d
cop_arybase %d
}
my $op = shift;
# pmnext is corrupt in some PMOPs (see misc.t for example)
#my $pmnextix = $op->pmnext->objix;
if ($$replroot) {
# OP_PUSHRE (a mutated version of OP_MATCH for the regexp
# argument to a split) stores a GV in op_pmreplroot instead
# of a substitution syntax tree. We don't want to walk that...
if ($opname eq "pushre") {
} else {
}
}
if ($opname eq "pushre") {
asmf "op_pmreplrootgv $replrootix\n";
} else {
asm "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n";
}
# op_pmnext omitted since a perl bug means it's sometime corrupt
op_pmflags 0x%x
op_pmpermflags 0x%x
}
my $sv = shift;
asm "sv_refcnt $refcnt\nsv_flags $flags\n";
mark_saved($sv);
}
my $sv = shift;
}
my $sv = shift;
}
my $sv = shift;
}
my $sv = shift;
asm "xrv $rvix\n";
}
my $sv = shift;
}
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
# table. It consists of 257 bytes (256 char array plus a final \0)
# which follow the ordinary PV+\0 and the 257 bytes are *not* reflected
# in SvCUR. $flag = 2 is used by AV::bytecode and means that we only
# call SV::bytecode instead of saving PV and calling NV::bytecode since
if ($flag == 2) {
} else {
if ($flag == 1) {
} else {
}
}
}
# See B::PVNV::bytecode for an explanation of $flag.
# XXX We assume SvSTASH is already saved and don't save it later ourselves
#
# We need to traverse the magic chain and get objix for each OBJ
# field *before* we do B::PVNV::bytecode since objix overwrites
# the sv register. However, we need to write the magic-saving
# bytecode *after* B::PVNV::bytecode since sv isn't initialised
# to refer to $sv until then.
#
asm "xmg_stash $stashix\n";
asmf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n",
}
}
my $sv = shift;
xlv_targoff %d
xlv_targlen %d
xlv_type %s
}
my $sv = shift;
# See PVNV::bytecode for an explanation of what the argument does
asmf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n",
}
sub empty_gv { # is a GV empty except for imported stuff?
my $gv = shift;
@subfield_names = grep {;
no strict 'refs';
} @subfield_names;
return scalar @subfield_names;
}
my $gv = shift;
mark_saved($gv);
sv_flags 0x%x
xgv_flags 0x%x
gp_line %d
gp_file %d
asm "gp_share $egvix\n";
} else {
my $i;
@subfield_names = grep {;
no strict 'refs';
} @subfield_names;
# Reset sv register for $gv
for ($i = 0; $i < @ixes; $i++) {
}
# Now save all the subfields
my $sv;
}
}
}
}
my $hv = shift;
mark_saved($hv);
if (!$name) {
# It's an ordinary HV. Stashes have NAME set and need no further
# saving beyond the gv_stashpv that $hv->objix already ensures.
my ($i, @ixes);
}
}
asmf("newpv %s\nhv_store %d\n",
}
}
}
my $av = shift;
if ($fill > -1) {
my $sv;
}
}
# See PVNV::bytecode for the meaning of the flag argument of 2.
# Recover sv register and set AvMAX and AvFILL to -1 (since we
# create an AV with NEWSV and SvUPGRADE rather than doing newAV
# which is what sets AvMAX and AvFILL.
if ($fill > -1) {
my $elix;
asm "av_push $elix\n";
}
} else {
if ($max > -1) {
asm "av_extend $max\n";
}
}
}
my $cv = shift;
my $i;
# Save OP tree from CvROOT (first element of @subfields)
if ($$root) {
}
# Reset sv register for $cv (since above ->objix calls stomped on it)
for ($i = 0; $i < @ixes; $i++) {
}
# Now save all the subfields (except for CvROOT which was handled
# above) and CvSTART (now the initial element of @subfields).
shift @subfields; # bye-bye CvSTART
my $sv;
}
}
my $io = shift;
asm "xio_top_gv $top_gvix\n";
asm "xio_fmt_gv $fmt_gvix\n";
asm "xio_bottom_gv $bottom_gvix\n";
my $field;
}
}
}
# nothing extra needs doing
}
sub bytecompile_object {
for my $sv (@_) {
}
}
sub B::GV::bytecodecv {
my $gv = shift;
if ($debug_cv) {
warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
}
}
}
sub save_call_queues {
while ($$op) {
last OPLOOP;
}
}
}
}
}
}
}
}
}
sub symwalk {
no strict 'refs';
if (grep { /^$_[0]/; } @packages) {
}
if $debug_bc;
$ok;
}
sub bytecompile_main {
warn "done main program, now walking symbol table\n" if $debug_bc;
if (@packages) {
no strict qw(refs);
} else {
die "No packages requested for compilation!\n";
}
asmf "curpad $curpadix\n";
# XXX Do min_intro_pending and max_intro_pending matter?
}
sub compile {
my @options = @_;
open(OUT, ">&STDOUT");
binmode OUT;
select OUT;
if ($option =~ /^-(.)(.*)/) {
$opt = $1;
$arg = $2;
} else {
last OPTION;
}
shift @options;
last OPTION;
} elsif ($opt eq "o") {
binmode OUT;
} elsif ($opt eq "a") {
binmode OUT;
} elsif ($opt eq "D") {
if ($arg eq "b") {
$| = 1;
debug(1);
} elsif ($arg eq "o") {
B->debug(1);
} elsif ($arg eq "a") {
} elsif ($arg eq "C") {
$debug_cv = 1;
}
}
} elsif ($opt eq "v") {
$verbose = 1;
} elsif ($opt eq "S") {
$no_assemble = 1;
} elsif ($opt eq "f") {
$arg =~ s/-/_/g;
if (defined($ref)) {
} else {
}
} elsif ($opt eq "O") {
my $ref;
$$ref = 0;
}
if ($arg >= 2) {
$bypass_nullops = 1;
}
if ($arg >= 1) {
$compress_nullops = 1;
$omit_seq = 1;
}
} elsif ($opt eq "u") {
} else {
}
}
if (! @packages) {
warn "No package specified for compilation, assuming main::\n";
}
if (@options) {
die "Extraneous options left on B::Bytecode commandline: @options\n";
} else {
return sub {
endasm() unless $no_assemble;
};
}
}
sub apr { print @_; }
1;
=head1 NAME
B::Bytecode - Perl compiler's bytecode backend
=head1 SYNOPSIS
perl -MO=Bytecode[,OPTIONS] foo.pl
=head1 DESCRIPTION
This compiler backend takes Perl source and generates a
platform-independent bytecode encapsulating code to load the
internal structures perl uses to run your program. When the
generated bytecode is loaded in, your program is ready to run,
reducing the time which perl would have taken to load and parse
your program into its internal semi-compiled form. That means that
compiling with this backend will not help improve the runtime
execution speed of your program but may improve the start-up time.
Depending on the environment in which your program runs this may
or may not be a help.
The resulting bytecode can be run with a special byteperl executable
or (for non-main programs) be loaded via the C<byteload_fh> function
in the F<B> module.
=head1 OPTIONS
If there are any non-option arguments, they are taken to be names of
objects to be saved (probably doesn't work properly yet). Without
extra arguments, it saves the main program.
=over 4
=item B<-ofilename>
Output to filename instead of STDOUT.
=item B<-afilename>
Append output to filename.
=item B<-->
Force end of options.
=item B<-f>
Force optimisations on or off one at a time. Each can be preceded
by B<no-> to turn the option off (e.g. B<-fno-compress-nullops>).
=item B<-fcompress-nullops>
Only fills in the necessary fields of ops which have
been optimised away by perl's internal compiler.
=item B<-fomit-sequence-numbers>
Leaves out code to fill in the op_seq field of all ops
which is only used by perl's internal compiler.
=item B<-fbypass-nullops>
If op->op_next ever points to a NULLOP, replaces the op_next field
with the first non-NULLOP in the path of execution.
=item B<-On>
Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
B<-O1> sets B<-fcompress-nullops> B<-fomit-sequence numbers>.
B<-O2> adds B<-fbypass-nullops>.
=item B<-D>
Debug options (concatenated or separate flags like C<perl -D>).
=item B<-Do>
Prints each OP as it's processed.
=item B<-Db>
Print debugging information about bytecompiler progress.
=item B<-Da>
Tells the (bytecode) assembler to include source assembler lines
in its output as bytecode comments.
=item B<-DC>
Prints each CV taken from the final symbol tree walk.
=item B<-S>
Output (bytecode) assembler source rather than piping it
through the assembler and outputting bytecode.
=item B<-upackage>
Stores package in the output.
=back
=head1 EXAMPLES
perl -MO=Bytecode,-S,-umain foo.pl > foo.S
assemble foo.S > foo.plc
Note that C<assemble> lives in the C<B> subdirectory of your perl
library directory. The utility called perlcc may also be used to
help make use of this compiler.
=head1 BUGS
Output is still huge and there are still occasional crashes during
either compilation or ByteLoading. Current status: experimental.
=head1 AUTHORS
Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
Benjamin Stuhl, C<sho_pi@hotmail.com>
=cut