more cleanups for change#4539

[p5sagit/p5-mst-13.2.git] / ext / B / B / Bytecode.pm

diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
index 0c5a58d..da8808a 100644 (file)
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -11,7 +11,9 @@ use Carp;
 use IO::File;
 
 use B qw(minus_c main_cv main_root main_start comppadlist
-        class peekop walkoptree svref_2object cstring walksymtable);
+        class peekop walkoptree svref_2object cstring walksymtable
+        SVf_POK SVp_POK SVf_IOK SVp_IOK
+       );
 use B::Asmdata qw(@optype @specialsv_name);
 use B::Assembler qw(assemble_fh);
 
@@ -23,11 +25,11 @@ for ($i = 0; $i < @optype; $i++) {
 
 # Following is SVf_POK|SVp_POK
 # XXX Shouldn't be hardwired
-sub POK () { 0x04040000 }
+sub POK () { SVf_POK|SVp_POK }
 
-# Following is SVf_IOK|SVp_OK
+# Following is SVf_IOK|SVp_IOK
 # XXX Shouldn't be hardwired
-sub IOK () { 0x01010000 }
+sub IOK () { SVf_IOK|SVp_IOK }
 
 my ($verbose, $module_only, $no_assemble, $debug_bc, $debug_cv);
 my $assembler_pid;
@@ -191,7 +193,7 @@ sub B::OP::bytecode {
     ldop($ix);
     print "op_next $nextix\n";
     print "op_sibling $sibix\n" unless $strip_syntree;
-    printf "op_type %s\t# %d\n", $op->ppaddr, $type;
+    printf "op_type %s\t# %d\n", "pp_" . $op->name, $type;
     printf("op_seq %d\n", $op->seq) unless $omit_seq;
     if ($type || !$compress_nullops) {
        printf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n",
@@ -224,13 +226,11 @@ sub B::SVOP::bytecode {
     $sv->bytecode;
 }
 
-sub B::GVOP::bytecode {
+sub B::PADOP::bytecode {
     my $op = shift;
-    my $gv = $op->gv;
-    my $gvix = $gv->objix;
+    my $padix = $op->padix;
     $op->B::OP::bytecode;
-    print "op_gv $gvix\n";
-    $gv->bytecode;
+    print "op_padix $padix\n";
 }
 
 sub B::PVOP::bytecode {
@@ -241,7 +241,7 @@ sub B::PVOP::bytecode {
     # 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.
     #
-    if ($op->ppaddr eq "pp_trans") {
+    if ($op->name eq "trans") {
        my @shorts = unpack("s256", $pv); # assembler handles endianness
        print "op_pv_tr ", join(",", @shorts), "\n";
     } else {
@@ -258,14 +258,6 @@ sub B::BINOP::bytecode {
     }
 }
 
-sub B::CONDOP::bytecode {
-    my $op = shift;
-    my $trueix = $op->true->objix;
-    my $falseix = $op->false->objix;
-    $op->B::UNOP::bytecode;
-    print "op_true $trueix\nop_false $falseix\n";
-}
-
 sub B::LISTOP::bytecode {
     my $op = shift;
     my $children = $op->children;
@@ -291,6 +283,8 @@ sub B::COP::bytecode {
     my $filegv = $op->filegv;
     my $filegvix = $filegv->objix;
     my $line = $op->line;
+    my $warnings = $op->warnings;
+    my $warningsix = $warnings->objix;
     if ($debug_bc) {
        printf "# line %s:%d\n", $filegv->SV->PV, $line;
     }
@@ -303,6 +297,7 @@ cop_seq %d
 cop_filegv $filegvix
 cop_arybase %d
 cop_line $line
+cop_warnings $warningsix
 EOT
     $filegv->bytecode;
     $stash->bytecode;
@@ -313,7 +308,7 @@ sub B::PMOP::bytecode {
     my $replroot = $op->pmreplroot;
     my $replrootix = $replroot->objix;
     my $replstartix = $op->pmreplstart->objix;
-    my $ppaddr = $op->ppaddr;
+    my $opname = $op->name;
     # pmnext is corrupt in some PMOPs (see misc.t for example)
     #my $pmnextix = $op->pmnext->objix;
 
@@ -321,14 +316,14 @@ sub B::PMOP::bytecode {
        # 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 ($ppaddr eq "pp_pushre") {
+       if ($opname eq "pushre") {
            $replroot->bytecode;
        } else {
            walkoptree($replroot, "bytecode");
        }
     }
     $op->B::LISTOP::bytecode;
-    if ($ppaddr eq "pp_pushre") {
+    if ($opname eq "pushre") {
        printf "op_pmreplrootgv $replrootix\n";
     } else {
        print "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n";
@@ -395,7 +390,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
@@ -474,10 +470,12 @@ sub B::GV::bytecode {
     my $egv = $gv->EGV;
     my $egvix = $egv->objix;
     ldsv($ix);
-    printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS, $gv->LINE;
+    printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS, $gv->LINE, pvstring($gv->FILE);
 sv_flags 0x%x
 xgv_flags 0x%x
 gp_line %d
+newpv %s
+gp_file
 EOT
     my $refcnt = $gv->REFCNT;
     printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
@@ -488,7 +486,7 @@ EOT
     } else {
        if ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
            my $i;
-           my @subfield_names = qw(SV AV HV CV FILEGV FORM IO);
+           my @subfield_names = qw(SV AV HV CV FORM IO);
            my @subfields = map($gv->$_(), @subfield_names);
            my @ixes = map($_->objix, @subfields);
            # Reset sv register for $gv
@@ -571,7 +569,7 @@ sub B::CV::bytecode {
     my $ix = $cv->objix;
     $cv->B::PVMG::bytecode;
     my $i;
-    my @subfield_names = qw(ROOT START STASH GV FILEGV PADLIST OUTSIDE);
+    my @subfield_names = qw(ROOT START STASH GV PADLIST OUTSIDE);
     my @subfields = map($cv->$_(), @subfield_names);
     my @ixes = map($_->objix, @subfields);
     # Save OP tree from CvROOT (first element of @subfields)
@@ -889,13 +887,16 @@ C<main_root> and C<curpad> are omitted.
 
 =head1 EXAMPLES
 
-        perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
+    perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
+
+    perl -MO=Bytecode,-S foo.pl > foo.S
+    assemble foo.S > foo.plc
 
-        perl -MO=Bytecode,-S foo.pl > foo.S
-        assemble foo.S > foo.plc
-        byteperl 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.
 
-        perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm
+    perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm
 
 =head1 BUGS