Remove perlcc and the byteloader
Rafael Garcia-Suarez [Wed, 6 Sep 2006 14:04:33 +0000 (14:04 +0000)]
p4raw-id: //depot/perl@28790

57 files changed:
MANIFEST
Makefile.SH
NetWare/Makefile
bytecode.pl
configure.com
ext/B/B/Asmdata.pm
ext/B/B/Assembler.pm [deleted file]
ext/B/B/Bblock.pm [deleted file]
ext/B/B/Bytecode.pm [deleted file]
ext/B/B/C.pm [deleted file]
ext/B/B/CC.pm [deleted file]
ext/B/B/Disassembler.pm [deleted file]
ext/B/B/Stackobj.pm [deleted file]
ext/B/B/Stash.pm [deleted file]
ext/B/B/assemble [deleted file]
ext/B/B/cc_harness [deleted file]
ext/B/B/disassemble [deleted file]
ext/B/B/makeliblinks [deleted file]
ext/B/C/C.xs [deleted file]
ext/B/C/Makefile.PL [deleted file]
ext/B/NOTES [deleted file]
ext/B/README [deleted file]
ext/B/TESTS [deleted file]
ext/B/Todo [deleted file]
ext/B/ramblings/cc.notes [deleted file]
ext/B/ramblings/curcop.runtime [deleted file]
ext/B/ramblings/flip-flop [deleted file]
ext/B/ramblings/magic [deleted file]
ext/B/ramblings/reg.alloc [deleted file]
ext/B/ramblings/runtime.porting [deleted file]
ext/B/t/asmdata.t [deleted file]
ext/B/t/assembler.t [deleted file]
ext/B/t/bblock.t [deleted file]
ext/B/t/bytecode.t [deleted file]
ext/B/t/stash.t [deleted file]
ext/ByteLoader/ByteLoader.pm [deleted file]
ext/ByteLoader/ByteLoader.xs [deleted file]
ext/ByteLoader/Makefile.PL [deleted file]
ext/ByteLoader/bytecode.h [deleted file]
ext/ByteLoader/byterun.c [deleted file]
ext/ByteLoader/byterun.h [deleted file]
ext/ByteLoader/hints/sunos.pl [deleted file]
ext/threads/shared/typemap [deleted file]
pod/Makefile.SH
pod/perlcompile.pod
regen.pl
t/TEST
t/harness
t/lib/1_compile.t
utils.lst
utils/Makefile
utils/perlcc.PL [deleted file]
vms/descrip_mms.template
win32/Makefile
win32/makefile.mk
win32/pod.mak
x2p/Makefile.SH

index fa8a6d0..01b20bc 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -7,7 +7,7 @@ av.h                    Array value header
 beos/beos.c            BeOS port
 beos/beosish.h         BeOS port
 beos/nm.c              BeOS port
-bytecode.pl            Produces ext/ByteLoader/byterun.h, ext/ByteLoader/byterun.c and ext/B/Asmdata.pm
+bytecode.pl            Produces ext/B/Asmdata.pm
 cc_runtime.h           Macros need by runtime of compiler-generated code
 cflags.SH              A script that emits C compilation flags per file
 Changes                        Differences from previous version
@@ -70,58 +70,30 @@ ext/attrs/attrs.xs          attrs extension external subroutines
 ext/attrs/Makefile.PL          attrs extension makefile writer
 ext/attrs/t/attrs.t            See if attrs works with C<sub : attrs>
 ext/B/B/Asmdata.pm     Compiler backend data for assembler
-ext/B/B/assemble       Assemble compiler bytecode
-ext/B/B/Assembler.pm   Compiler backend assembler support functions
-ext/B/B/Bblock.pm      Compiler basic block analysis support
-ext/B/B/Bytecode.pm    Compiler Bytecode backend
-ext/B/B/cc_harness     Simplistic wrapper for using -MO=CC compiler
-ext/B/B/CC.pm          Compiler CC backend
 ext/B/B/Concise.pm     Compiler Concise backend
-ext/B/B/C.pm           Compiler C backend
 ext/B/B/Debug.pm       Compiler Debug backend
 ext/B/B/Deparse.pm     Compiler Deparse backend
-ext/B/B/disassemble    Disassemble compiler bytecode output
-ext/B/B/Disassembler.pm        Compiler Disassembler backend
 ext/B/B/Lint.pm                Compiler Lint backend
-ext/B/B/makeliblinks   Make a simplistic XSUB .so symlink tree for compiler
 ext/B/B.pm             Compiler backend support functions and methods
 ext/B/B/Showlex.pm     Compiler Showlex backend
-ext/B/B/Stackobj.pm    Compiler stack objects support functions
-ext/B/B/Stash.pm       Compiler module to identify stashes
 ext/B/B/Terse.pm       Compiler Terse backend
 ext/B/B/Xref.pm                Compiler Xref backend
 ext/B/B.xs             Compiler backend external subroutines
-ext/B/C/C.xs           Compiler C backend external subroutines
-ext/B/C/Makefile.PL    Compiler C backend makefile writer
 ext/B/defsubs_h.PL     Generator for constant subroutines
 ext/B/hints/darwin.pl  Hints for named architecture
 ext/B/hints/openbsd.pl Hints for named architecture
 ext/B/Makefile.PL      Compiler backend makefile writer
-ext/B/NOTES            Compiler backend notes
 ext/B/O.pm             Compiler front-end module (-MO=...)
-ext/B/ramblings/cc.notes       Compiler ramblings: notes on CC backend
-ext/B/ramblings/curcop.runtime Compiler ramblings: notes on curcop use
-ext/B/ramblings/flip-flop      Compiler ramblings: notes on flip-flop
-ext/B/ramblings/magic          Compiler ramblings: notes on magic
-ext/B/ramblings/reg.alloc      Compiler ramblings: register allocation
-ext/B/ramblings/runtime.porting        Compiler ramblings: porting PP engine
-ext/B/README           Compiler backend README
-ext/B/t/asmdata.t      See if B::Asmdata works
-ext/B/t/assembler.t    See if B::Assembler, B::Disassembler comply
-ext/B/t/bblock.t       See if B::Bblock works
 ext/B/t/b.t            See if B works
-ext/B/t/bytecode.t     See whether B::Bytecode works
 ext/B/t/concise.t      See whether B::Concise works
 ext/B/t/concise-xs.t   See whether B::Concise recognizes XS functions
 ext/B/t/debug.t                See if B::Debug works
 ext/B/t/deparse.t      See if B::Deparse works
-ext/B/TESTS            Compiler backend test data
 ext/B/t/f_map                  code from perldoc -f map
 ext/B/t/f_map.t                        converted to optreeCheck()s
 ext/B/t/f_sort                 optree test raw material
 ext/B/t/f_sort.t               optree test raw material
 ext/B/t/lint.t         See if B::Lint works
-ext/B/Todo             Compiler backend Todo list
 ext/B/t/OptreeCheck.pm         optree comparison tool
 ext/B/t/optree_check.t         test OptreeCheck apparatus
 ext/B/t/optree_concise.t       more B::Concise tests
@@ -133,17 +105,9 @@ ext/B/t/optree_specials.t  BEGIN, END, etc code
 ext/B/t/optree_varinit.t       my,our,local var init optimization
 ext/B/t/o.t            See if O works
 ext/B/t/showlex.t      See if B::ShowLex works
-ext/B/t/stash.t                See if B::Stash works
 ext/B/t/terse.t                See if B::Terse works
 ext/B/t/xref.t         See if B::Xref works
 ext/B/typemap                  Compiler backend interface types
-ext/ByteLoader/bytecode.h      Bytecode header for bytecode loader
-ext/ByteLoader/ByteLoader.pm   Bytecode loader Perl module
-ext/ByteLoader/ByteLoader.xs   Bytecode loader external subroutines
-ext/ByteLoader/byterun.c       Runtime support for bytecode loader
-ext/ByteLoader/byterun.h       Header for byterun.c
-ext/ByteLoader/hints/sunos.pl  Hints for named architecture
-ext/ByteLoader/Makefile.PL     Bytecode loader makefile writer
 ext/Compress/IO/Base/Changes   IO::Compress::Base
 ext/Compress/IO/Base/lib/File/GlobMapper.pm    IO::Compress::Base
 ext/Compress/IO/Base/lib/IO/Compress/Base/Common.pm    IO::Compress::Base
@@ -3612,7 +3576,6 @@ utils/libnetcfg.PL                libnet
 utils.lst                      Lists utilities bundled with Perl
 utils/Makefile                 Extract the utility scripts
 utils/perlbug.PL               A simple tool to submit a bug report
-utils/perlcc.PL                        Front-end for compiler
 utils/perldoc.PL               A simple tool to find & display perl's documentation
 utils/perlivp.PL               installation verification procedure
 utils/piconv.PL                        iconv(1), reinvented in perl
index 099fed2..999bd95 100644 (file)
@@ -443,13 +443,7 @@ all: $(FIRSTMAKEFILE) miniperl$(EXE_EXT) extra.pods $(private) $(unidatafiles) $
        @echo " ";
        @echo " Everything is up to date. Type '$(MAKE) test' to run test suite."
 
-.PHONY: all compile translators utilities
-
-compile: all
-       echo "testing compilation" > testcompile;
-       cd utils;  $(MAKE) compile;
-       cd x2p; $(MAKE) compile;
-       cd pod; $(MAKE) compile;
+.PHONY: all translators utilities
 
 translators:   miniperl$(EXE_EXT) $(CONFIGPM) FORCE
        @echo " "; echo "       Making x2p stuff"; cd x2p; $(LDLIBPTH) $(MAKE) all
@@ -894,13 +888,6 @@ no-install:
 INSTALL_DEPENDENCE = all
 
 install.perl:  $(INSTALL_DEPENDENCE) installperl
-       if [ -n "$(COMPILE)" ]; \
-       then \
-               cd utils; $(MAKE) compile; \
-               cd ../x2p; $(MAKE) compile; \
-               cd ../pod; $(MAKE) compile; \
-       else :; \
-       fi
        $(LDLIBPTH) ./perl installperl --destdir=$(DESTDIR) $(INSTALLFLAGS) $(STRIPFLAGS)
        $(MAKE) extras.install
 
@@ -963,8 +950,6 @@ CHMOD_W = chmod +w
 
 # The following files are generated automatically
 #      autodoc.pl:     pod/perlapi.pod pod/perlintern.pod
-#      bytecode.pl:    ext/ByteLoader/byterun.h ext/ByteLoader/byterun.c
-#                      ext/B/B/Asmdata.pm
 #      embed.pl:       proto.h embed.h embedvar.h global.sym
 #                      perlapi.h perlapi.c 
 # [* embed.pl needs pp.sym generated by opcode.pl! *]
@@ -982,8 +967,7 @@ CHMOD_W = chmod +w
 AUTOGEN_FILES = keywords.h opcode.h opnames.h pp_proto.h pp.sym proto.h \
                embed.h embedvar.h global.sym \
                pod/perlintern.pod pod/perlapi.pod \
-               perlapi.h perlapi.c ext/ByteLoader/byterun.h \
-               ext/ByteLoader/byterun.c ext/B/B/Asmdata.pm regnodes.h \
+               perlapi.h perlapi.c regnodes.h \
                warnings.h lib/warnings.pm
 
 .PHONY: regen_headers regen_pods regen_all
@@ -1084,7 +1068,6 @@ _tidy:
        -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) $(nonxs_ext) ; do \
        $(LDLIBPTH) sh ext/util/make_ext clean $$x MAKE=$(MAKE) ; \
        done
-       rm -f testcompile compilelog
 
 _cleaner1:
        -cd os2; rm -f Makefile
@@ -1111,7 +1094,6 @@ _cleaner2:
        rm -f h2ph.man pstruct
        rm -rf .config
        rm -f preload
-       rm -f testcompile compilelog
        rm -rf lib/Encode lib/Compress lib/Hash
        rm -rf lib/IO/Compress lib/IO/Uncompress
        rm -f lib/ExtUtils/ParseXS/t/XSTest.c
@@ -1169,7 +1151,7 @@ makedepend: makedepend.SH config.sh
        test.utf16 check.utf16 utest.utf16 ucheck.utf16 \
        test.third check.third utest.third ucheck.third test_notty.third \
        test.deparse test_notty.deparse test_harness test_harness_notty \
-       test.bytecompile minitest coretest test.taintwarn
+       minitest coretest test.taintwarn
 
 # Cannot delegate rebuilding of t/perl to make
 # to allow interlaced test and minitest
@@ -1268,11 +1250,6 @@ utest.third ucheck.third: test_prep.third perl.third
 test_notty.third: test_prep.third perl.third
        PERL=./perl.third $(MAKE) PERL_DEBUG=PERL_3LOG=1 _test_notty
 
-# Targets for Bytecode/ByteLoader testing.
-
-test.bytecompile:      test_prep
-       PERL=./perl TEST_ARGS=-bytecompile $(MAKE) _test
-
 # Targets for Deparse testing.
 
 test.deparse:  test_prep
index 96e2657..adf617c 100644 (file)
@@ -669,7 +669,6 @@ UTILS               =                       \
                ..\utils\c2ph           \
                ..\utils\h2xs           \
                ..\utils\perldoc        \
-               ..\utils\perlcc         \
                ..\pod\checkpods        \
                ..\pod\pod2html         \
                ..\pod\pod2latex        \
index cbbdefa..95b5b12 100644 (file)
@@ -39,7 +39,7 @@ EOT
 my $perl_header;
 ($perl_header = $c_header) =~ s{[/ ]?\*/?}{#}g;
 
-safer_unlink "ext/ByteLoader/byterun.c", "ext/ByteLoader/byterun.h", "ext/B/B/Asmdata.pm";
+safer_unlink "ext/B/B/Asmdata.pm";
 
 #
 # Start with boilerplate for Asmdata.pm
@@ -66,79 +66,12 @@ print ASMDATA_PM <<"EOT";
 # I get a hard-to-track-down stack underflow and segfault.
 EOT
 
-#
-# Boilerplate for byterun.c
-#
-open(BYTERUN_C, ">ext/ByteLoader/byterun.c") or die "ext/ByteLoader/byterun.c: $!";
-binmode BYTERUN_C;
-print BYTERUN_C $c_header, <<'EOT';
-
-#define PERL_NO_GET_CONTEXT
-#include "EXTERN.h"
-#include "perl.h"
-#define NO_XSLOCKS
-#include "XSUB.h"
-
-#include "byterun.h"
-#include "bytecode.h"
-
-
-static const int optype_size[] = {
-EOT
-my $i = 0;
-for ($i = 0; $i < @optype - 1; $i++) {
-    printf BYTERUN_C "    sizeof(%s),\n", $optype[$i], $i;
-}
-printf BYTERUN_C "    sizeof(%s)\n", $optype[$i], $i;
-
 my $size = @specialsv;
 
-print BYTERUN_C <<"EOT";
-};
-
-void *
-bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix)
-{
-    if (ix > bstate->bs_obj_list_fill) {
-       Renew(bstate->bs_obj_list, ix + 32, void*);
-       bstate->bs_obj_list_fill = ix + 31;
-    }
-    bstate->bs_obj_list[ix] = obj;
-    return obj;
-}
-
-int
-byterun(pTHX_ register struct byteloader_state *bstate)
-{
-    dVAR;
-    register int insn;
-    U32 ix;
-    SV *specialsv_list[$size];
-
-    BYTECODE_HEADER_CHECK;     /* croak if incorrect platform */
-    Newx(bstate->bs_obj_list, 32, void*); /* set op objlist */
-    bstate->bs_obj_list_fill = 31;
-    bstate->bs_obj_list[0] = NULL; /* first is always Null */
-    bstate->bs_ix = 1;
-
-EOT
-
-for my $i ( 0 .. $#specialsv ) {
-    print BYTERUN_C "    specialsv_list[$i] = $specialsv[$i];\n";
-}
-
-print BYTERUN_C <<'EOT';
-
-    while ((insn = BGET_FGETC()) != EOF) {
-       switch (insn) {
-EOT
-
-
 my (@insn_name, $insn_num, $insn, $lvalue, $argtype, $flags, $fundtype);
 
 while (<DATA>) {
     if (/^\s*#/) {
-       print BYTERUN_C if /^\s*#\s*(?:if|endif|el)/;
        next;
     }
     chop;
@@ -159,26 +92,6 @@ while (<DATA>) {
     $fundtype = $alias_from{$argtype} || $argtype;
 
     #
-    # Add the case statement and code for the bytecode interpreter in byterun.c
-    #
-    printf BYTERUN_C "\t  case INSN_%s:\t\t/* %d */\n\t    {\n",
-       uc($insn), $insn_num;
-    my $optarg = $argtype eq "none" ? "" : ", arg";
-    if ($optarg) {
-       printf BYTERUN_C "\t\t$argtype arg;\n\t\tBGET_%s(arg);\n", $fundtype;
-    }
-    if ($flags =~ /x/) {
-       print BYTERUN_C "\t\tBSET_$insn($lvalue$optarg);\n";
-    } elsif ($flags =~ /s/) {
-       # Store instructions store to bytecode_obj_list[arg]. "lvalue" field is rvalue.
-       print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n";
-    }
-    elsif ($optarg && $lvalue ne "none") {
-       print BYTERUN_C "\t\t$lvalue = ${rvalcast}arg;\n";
-    }
-    print BYTERUN_C "\t\tbreak;\n\t    }\n";
-
-    #
     # Add the initialiser line for %insn_data in Asmdata.pm
     #
     print ASMDATA_PM <<"EOT";
@@ -190,82 +103,6 @@ EOT
 }
 
 #
-# Finish off byterun.c
-#
-print BYTERUN_C <<'EOT';
-         default:
-           Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn);
-           /* NOTREACHED */
-       }
-    }
-    return 0;
-}
-
-/* ex: set ro: */
-EOT
-
-#
-# Write the instruction and optype enum constants into byterun.h
-#
-open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!";
-binmode BYTERUN_H;
-print BYTERUN_H $c_header, <<'EOT';
-struct byteloader_fdata {
-    SV *datasv;
-    int next_out;
-    int        idx;
-};
-
-struct byteloader_pv_state {
-    char                       *pvx;
-    XPV                                xpv;
-};
-
-struct byteloader_state {
-    struct byteloader_fdata    *bs_fdata;
-    SV                         *bs_sv;
-    void                       **bs_obj_list;
-    int                                bs_obj_list_fill;
-    int                                bs_ix;
-    struct byteloader_pv_state bs_pv;
-    int                                bs_iv_overflows;
-};
-
-int bl_getc(struct byteloader_fdata *);
-int bl_read(struct byteloader_fdata *, char *, size_t, size_t);
-extern int byterun(pTHX_ struct byteloader_state *);
-
-enum {
-EOT
-
-my $add_enum_value = 0;
-my $max_insn;
-for $i ( 0 .. $#insn_name ) {
-    $insn = uc($insn_name[$i]);
-    if (defined($insn)) {
-       $max_insn = $i;
-       if ($add_enum_value) {
-           print BYTERUN_H "    INSN_$insn = $i,\t\t\t/* $i */\n";
-           $add_enum_value = 0;
-       } else {
-           print BYTERUN_H "    INSN_$insn,\t\t\t/* $i */\n";
-       }
-    } else {
-       $add_enum_value = 1;
-    }
-}
-
-print BYTERUN_H "    MAX_INSN = $max_insn\n};\n";
-
-print BYTERUN_H "\nenum {\n";
-for ($i = 0; $i < @optype - 1; $i++) {
-    printf BYTERUN_H "    OPt_%s,\t\t/* %d */\n", $optype[$i], $i;
-}
-printf BYTERUN_H "    OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i;
-
-print BYTERUN_H "/* ex: set ro: */\n";
-
-#
 # Finish off insn_data and create array initialisers in Asmdata.pm
 #
 print ASMDATA_PM <<'EOT';
@@ -283,7 +120,7 @@ __END__
 
 =head1 NAME
 
-B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
+B::Asmdata - Autogenerated data about Perl ops
 
 =head1 SYNOPSIS
 
@@ -346,8 +183,6 @@ EOT
 
 
 close ASMDATA_PM or die "Error closing ASMDATA_PM: $!";
-close BYTERUN_H or die "Error closing BYTERUN_H: $!";
-close BYTERUN_C or die "Error closing BYTERUN_C: $!";
 
 __END__
 # First set instruction ord("#") to read comment to end-of-line (sneaky)
index 45a69a1..b9e94f0 100644 (file)
@@ -6989,7 +6989,6 @@ $ WRITE CONFIG "$ h2xs       == """ + perl_setup_perl + " ''vms_prefix':[utils]h
 $ WRITE CONFIG "$ instmodsh  == """ + perl_setup_perl + " ''vms_prefix':[utils]instmodsh.com"""
 $ WRITE CONFIG "$ libnetcfg  == """ + perl_setup_perl + " ''vms_prefix':[utils]libnetcfg.com"""
 $ WRITE CONFIG "$ perlbug    == """ + perl_setup_perl + " ''vms_prefix':[utils]perlbug.com"""
-$ WRITE CONFIG "$!perlcc     == """ + perl_setup_perl + " ''vms_prefix':[utils]perlcc.com"""
 $ WRITE CONFIG "$ perldoc    == """ + perl_setup_perl + " ''vms_prefix':[utils]perldoc.com """"-t"""""""
 $ WRITE CONFIG "$ perlivp    == """ + perl_setup_perl + " ''vms_prefix':[utils]perlivp.com"""
 $ WRITE CONFIG "$ piconv     == """ + perl_setup_perl + " ''vms_prefix':[utils]piconv.com"""
index f9dd98c..1cdbe13 100644 (file)
@@ -187,7 +187,7 @@ __END__
 
 =head1 NAME
 
-B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
+B::Asmdata - Autogenerated data about Perl ops
 
 =head1 SYNOPSIS
 
diff --git a/ext/B/B/Assembler.pm b/ext/B/B/Assembler.pm
deleted file mode 100644 (file)
index 461b9eb..0000000
+++ /dev/null
@@ -1,332 +0,0 @@
-#      Assembler.pm
-#
-#      Copyright (c) 1996 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::Assembler;
-use Exporter;
-use B qw(ppname);
-use B::Asmdata qw(%insn_data @insn_name);
-use Config qw(%Config);
-require ByteLoader;            # we just need its $VERSION
-
-no warnings;                   # XXX
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(assemble_fh newasm endasm assemble asm);
-$VERSION = 0.07;
-
-use strict;
-my %opnumber;
-my ($i, $opname);
-for ($i = 0; defined($opname = ppname($i)); $i++) {
-    $opnumber{$opname} = $i;
-}
-
-my($linenum, $errors, $out); # global state, set up by newasm
-
-sub error {
-    my $str = shift;
-    warn "$linenum: $str\n";
-    $errors++;
-}
-
-my $debug = 0;
-sub debug { $debug = shift }
-
-sub limcheck($$$$){
-    my( $val, $lo, $hi, $loc ) = @_;
-    if( $val < $lo || $hi < $val ){
-        error "argument for $loc outside [$lo, $hi]: $val";
-        $val = $hi;
-    }
-    return $val;
-}
-
-#
-# First define all the data conversion subs to which Asmdata will refer
-#
-
-sub B::Asmdata::PUT_U8 {
-    my $arg = shift;
-    my $c = uncstring($arg);
-    if (defined($c)) {
-       if (length($c) != 1) {
-           error "argument for U8 is too long: $c";
-           $c = substr($c, 0, 1);
-       }
-    } else {
-        $arg = limcheck( $arg, 0, 0xff, 'U8' );
-       $c = chr($arg);
-    }
-    return $c;
-}
-
-sub B::Asmdata::PUT_U16 {
-    my $arg = limcheck( $_[0], 0, 0xffff, 'U16' );
-    pack("S", $arg);
-}
-sub B::Asmdata::PUT_U32 {
-    my $arg = limcheck( $_[0], 0, 0xffffffff, 'U32' );
-    pack("L", $arg);
-}
-sub B::Asmdata::PUT_I32 {
-    my $arg = limcheck( $_[0], -0x80000000, 0x7fffffff, 'I32' );
-    pack("l", $arg);
-}
-sub B::Asmdata::PUT_NV  { sprintf("%s\0", $_[0]) } # "%lf" looses precision and pack('d',...)
-                                                  # may not even be portable between compilers
-sub B::Asmdata::PUT_objindex { # could allow names here
-    my $arg = limcheck( $_[0], 0, 0xffffffff, '*index' );
-    pack("L", $arg);
-} 
-sub B::Asmdata::PUT_svindex { &B::Asmdata::PUT_objindex }
-sub B::Asmdata::PUT_opindex { &B::Asmdata::PUT_objindex }
-sub B::Asmdata::PUT_pvindex { &B::Asmdata::PUT_objindex }
-
-sub B::Asmdata::PUT_strconst {
-    my $arg = shift;
-    my $str = uncstring($arg);
-    if (!defined($str)) {
-       error "bad string constant: $arg";
-       $str = '';
-    }
-    if ($str =~ s/\0//g) {
-       error "string constant argument contains NUL: $arg";
-        $str = '';
-    }
-    return $str . "\0";
-}
-
-sub B::Asmdata::PUT_pvcontents {
-    my $arg = shift;
-    error "extraneous argument: $arg" if defined $arg;
-    return "";
-}
-sub B::Asmdata::PUT_PV {
-    my $arg = shift;
-    my $str = uncstring($arg);
-    if( ! defined($str) ){
-        error "bad string argument: $arg";
-        $str = '';
-    }
-    return pack("L", length($str)) . $str;
-}
-sub B::Asmdata::PUT_comment_t {
-    my $arg = shift;
-    $arg = uncstring($arg);
-    error "bad string argument: $arg" unless defined($arg);
-    if ($arg =~ s/\n//g) {
-       error "comment argument contains linefeed: $arg";
-    }
-    return $arg . "\n";
-}
-sub B::Asmdata::PUT_double { sprintf("%s\0", $_[0]) } # see PUT_NV above
-sub B::Asmdata::PUT_none {
-    my $arg = shift;
-    error "extraneous argument: $arg" if defined $arg;
-    return "";
-}
-sub B::Asmdata::PUT_op_tr_array {
-    my @ary = split /\s*,\s*/, shift;
-    return pack "S*", @ary;
-}
-
-sub B::Asmdata::PUT_IV64 {
-    return pack "Q", shift;
-}
-
-sub B::Asmdata::PUT_IV {
-    $Config{ivsize} == 4 ? &B::Asmdata::PUT_I32 : &B::Asmdata::PUT_IV64;
-}
-
-sub B::Asmdata::PUT_PADOFFSET {
-    $Config{ptrsize} == 8 ? &B::Asmdata::PUT_IV64 : &B::Asmdata::PUT_U32;
-}
-
-sub B::Asmdata::PUT_long {
-    $Config{longsize} == 8 ? &B::Asmdata::PUT_IV64 : &B::Asmdata::PUT_U32;
-}
-
-sub B::Asmdata::PUT_svtype { # svtype is an enum, so an int.
-    $Config{intsize} == 4 ? &B::Asmdata::PUT_U32 : &B::Asmdata::PUT_IV64;
-}
-
-my %unesc = (n => "\n", r => "\r", t => "\t", a => "\a",
-            b => "\b", f => "\f", v => "\013");
-
-sub uncstring {
-    my $s = shift;
-    $s =~ s/^"// and $s =~ s/"$// or return undef;
-    $s =~ s/\\(\d\d\d|.)/length($1) == 3 ? chr(oct($1)) : ($unesc{$1}||$1)/eg;
-    return $s;
-}
-
-sub strip_comments {
-    my $stmt = shift;
-    # Comments only allowed in instructions which don't take string arguments
-    # Treat string as a single line so .* eats \n characters.
-    $stmt =~ s{
-       ^\s*    # Ignore leading whitespace
-       (
-         [^"]* # A double quote '"' indicates a string argument. If we
-               # find a double quote, the match fails and we strip nothing.
-       )
-       \s*\#   # Any amount of whitespace plus the comment marker...
-       .*$     # ...which carries on to end-of-string.
-    }{$1}sx;   # Keep only the instruction and optional argument.
-    return $stmt;
-}
-
-# create the ByteCode header: magic, archname, ByteLoader $VERSION, ivsize,
-#      ptrsize, byteorder
-# nvtype is irrelevant (floats are stored as strings)
-# byteorder is strconst not U32 because of varying size issues
-
-sub gen_header {
-    my $header = "";
-
-    $header .= B::Asmdata::PUT_U32(0x43424c50);        # 'PLBC'
-    $header .= B::Asmdata::PUT_strconst('"' . $Config{archname}. '"');
-    $header .= B::Asmdata::PUT_strconst(qq["$ByteLoader::VERSION"]);
-    $header .= B::Asmdata::PUT_U32($Config{ivsize});
-    $header .= B::Asmdata::PUT_U32($Config{ptrsize});
-    $header;
-}
-
-sub parse_statement {
-    my $stmt = shift;
-    my ($insn, $arg) = $stmt =~ m{
-       ^\s*    # allow (but ignore) leading whitespace
-       (.*?)   # Instruction continues up until...
-       (?:     # ...an optional whitespace+argument group
-           \s+         # first whitespace.
-           (.*)        # The argument is all the rest (newlines included).
-       )?$     # anchor at end-of-line
-    }sx;
-    if (defined($arg)) {
-       if ($arg =~ s/^0x(?=[0-9a-fA-F]+$)//) {
-           $arg = hex($arg);
-       } elsif ($arg =~ s/^0(?=[0-7]+$)//) {
-           $arg = oct($arg);
-       } elsif ($arg =~ /^pp_/) {
-           $arg =~ s/\s*$//; # strip trailing whitespace
-           my $opnum = $opnumber{$arg};
-           if (defined($opnum)) {
-               $arg = $opnum;
-           } else {
-               error qq(No such op type "$arg");
-               $arg = 0;
-           }
-       }
-    }
-    return ($insn, $arg);
-}
-
-sub assemble_insn {
-    my ($insn, $arg) = @_;
-    my $data = $insn_data{$insn};
-    if (defined($data)) {
-       my ($bytecode, $putsub) = @{$data}[0, 1];
-       my $argcode = &$putsub($arg);
-       return chr($bytecode).$argcode;
-    } else {
-       error qq(no such instruction "$insn");
-       return "";
-    }
-}
-
-sub assemble_fh {
-    my ($fh, $out) = @_;
-    my $line;
-    my $asm = newasm($out);
-    while ($line = <$fh>) {
-       assemble($line);
-    }
-    endasm();
-}
-
-sub newasm {
-    my($outsub) = @_;
-
-    die "Invalid printing routine for B::Assembler\n" unless ref $outsub eq 'CODE';
-    die <<EOD if ref $out;
-Can't have multiple byteassembly sessions at once!
-       (perhaps you forgot an endasm()?)
-EOD
-
-    $linenum = $errors = 0;
-    $out = $outsub;
-
-    $out->(gen_header());
-}
-
-sub endasm {
-    if ($errors) {
-       die "There were $errors assembly errors\n";
-    }
-    $linenum = $errors = $out = 0;
-}
-
-sub assemble {
-    my($line) = @_;
-    my ($insn, $arg);
-    $linenum++;
-    chomp $line;
-    if ($debug) {
-       my $quotedline = $line;
-       $quotedline =~ s/\\/\\\\/g;
-       $quotedline =~ s/"/\\"/g;
-       $out->(assemble_insn("comment", qq("$quotedline")));
-    }
-    if( $line = strip_comments($line) ){
-        ($insn, $arg) = parse_statement($line);
-        $out->(assemble_insn($insn, $arg));
-        if ($debug) {
-           $out->(assemble_insn("nop", undef));
-        }
-    }
-}
-
-### temporary workaround
-
-sub asm {
-    return if $_[0] =~ /\s*\W/;
-    if (defined $_[1]) {
-       return if $_[1] eq "0" and
-           $_[0] !~ /^(?:newsvx?|av_pushx?|av_extend|xav_flags)$/;
-       return if $_[1] eq "1" and $_[0] =~ /^(?:sv_refcnt)$/;
-    }
-    assemble "@_";
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-B::Assembler - Assemble Perl bytecode
-
-=head1 SYNOPSIS
-
-       use B::Assembler qw(newasm endasm assemble);
-       newasm(\&printsub);     # sets up for assembly
-       assemble($buf);         # assembles one line
-       endasm();               # closes down
-
-       use B::Assembler qw(assemble_fh);
-       assemble_fh($fh, \&printsub);   # assemble everything in $fh
-
-=head1 DESCRIPTION
-
-See F<ext/B/B/Assembler.pm>.
-
-=head1 AUTHORS
-
-Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
-Per-statement interface by Benjamin Stuhl, C<sho_pi@hotmail.com>
-
-=cut
diff --git a/ext/B/B/Bblock.pm b/ext/B/B/Bblock.pm
deleted file mode 100644 (file)
index ade8181..0000000
+++ /dev/null
@@ -1,224 +0,0 @@
-package B::Bblock;
-
-our $VERSION = '1.02';
-
-use Exporter ();
-@ISA = "Exporter";
-@EXPORT_OK = qw(find_leaders);
-
-use B qw(peekop walkoptree walkoptree_exec
-        main_root main_start svref_2object
-         OPf_SPECIAL OPf_STACKED );
-
-use B::Concise qw(concise_cv concise_main set_style_standard);
-use strict;
-
-my $bblock;
-my @bblock_ends;
-
-sub mark_leader {
-    my $op = shift;
-    if ($$op) {
-       $bblock->{$$op} = $op;
-    }
-}
-
-sub remove_sortblock{
-    foreach (keys %$bblock){
-        my $leader=$$bblock{$_};       
-       delete $$bblock{$_} if( $leader == 0);   
-    }
-}
-sub find_leaders {
-    my ($root, $start) = @_;
-    $bblock = {};
-    mark_leader($start) if ( ref $start ne "B::NULL" );
-    walkoptree($root, "mark_if_leader") if ((ref $root) ne "B::NULL") ;
-    remove_sortblock();
-    return $bblock;
-}
-
-# Debugging
-sub walk_bblocks {
-    my ($root, $start) = @_;
-    my ($op, $lastop, $leader, $bb);
-    $bblock = {};
-    mark_leader($start);
-    walkoptree($root, "mark_if_leader");
-    my @leaders = values %$bblock;
-    while ($leader = shift @leaders) {
-       $lastop = $leader;
-       $op = $leader->next;
-       while ($$op && !exists($bblock->{$$op})) {
-           $bblock->{$$op} = $leader;
-           $lastop = $op;
-           $op = $op->next;
-       }
-       push(@bblock_ends, [$leader, $lastop]);
-    }
-    foreach $bb (@bblock_ends) {
-       ($leader, $lastop) = @$bb;
-       printf "%s .. %s\n", peekop($leader), peekop($lastop);
-       for ($op = $leader; $$op != $$lastop; $op = $op->next) {
-           printf "    %s\n", peekop($op);
-       }
-       printf "    %s\n", peekop($lastop);
-    }
-}
-
-sub walk_bblocks_obj {
-    my $cvref = shift;
-    my $cv = svref_2object($cvref);
-    walk_bblocks($cv->ROOT, $cv->START);
-}
-
-sub B::OP::mark_if_leader {}
-
-sub B::COP::mark_if_leader {
-    my $op = shift;
-    if ($op->label) {
-       mark_leader($op);
-    }
-}
-
-sub B::LOOP::mark_if_leader {
-    my $op = shift;
-    mark_leader($op->next);
-    mark_leader($op->nextop);
-    mark_leader($op->redoop);
-    mark_leader($op->lastop->next);
-}
-
-sub B::LOGOP::mark_if_leader {
-    my $op = shift;
-    my $opname = $op->name;
-    mark_leader($op->next);
-    if ($opname eq "entertry") {
-       mark_leader($op->other->next);
-    } else {
-       mark_leader($op->other);
-    }
-}
-
-sub B::LISTOP::mark_if_leader {
-    my $op = shift;
-    my $first=$op->first;
-    $first=$first->next while ($first->name eq "null");
-    mark_leader($op->first) unless (exists( $bblock->{$$first}));
-    mark_leader($op->next);
-    if ($op->name eq "sort" and $op->flags & OPf_SPECIAL
-       and $op->flags & OPf_STACKED){
-        my $root=$op->first->sibling->first;
-        my $leader=$root->first;
-        $bblock->{$$leader} = 0;
-    }
-}
-
-sub B::PMOP::mark_if_leader {
-    my $op = shift;
-    if ($op->name ne "pushre") {
-       my $replroot = $op->pmreplroot;
-       if ($$replroot) {
-           mark_leader($replroot);
-           mark_leader($op->next);
-           mark_leader($op->pmreplstart);
-       }
-    }
-}
-
-# PMOP stuff omitted
-
-sub compile {
-    my @options = @_;
-    B::clearsym();
-    if (@options) {
-       return sub {
-           my $objname;
-           foreach $objname (@options) {
-               $objname = "main::$objname" unless $objname =~ /::/;
-               eval "walk_bblocks_obj(\\&$objname)";
-               die "walk_bblocks_obj(\\&$objname) failed: $@" if $@;
-               print "-------\n";
-               set_style_standard("terse");
-               eval "concise_cv('exec', \\&$objname)";
-               die "concise_cv('exec', \\&$objname) failed: $@" if $@;
-           }
-       }
-    } else {
-       return sub {
-           walk_bblocks(main_root, main_start);
-           print "-------\n";
-           set_style_standard("terse");
-           concise_main("exec");
-       };
-    }
-}
-
-# Basic block leaders:
-#     Any COP (pp_nextstate) with a non-NULL label
-#     [The op after a pp_enter] Omit
-#     [The op after a pp_entersub. Don't count this one.]
-#     The ops pointed at by nextop, redoop and lastop->op_next of a LOOP
-#     The ops pointed at by op_next and op_other of a LOGOP, except
-#     for pp_entertry which has op_next and op_other->op_next
-#     The op pointed at by op_pmreplstart of a PMOP
-#     The op pointed at by op_other->op_pmreplstart of pp_substcont?
-#     [The op after a pp_return] Omit
-
-1;
-
-__END__
-
-=head1 NAME
-
-B::Bblock - Walk basic blocks
-
-=head1 SYNOPSIS
-
-  # External interface
-  perl -MO=Bblock[,OPTIONS] foo.pl
-
-  # Programmatic API
-  use B::Bblock qw(find_leaders);
-  my $leaders = find_leaders($root_op, $start_op);
-
-=head1 DESCRIPTION
-
-This module is used by the B::CC back end.  It walks "basic blocks".
-A basic block is a series of operations which is known to execute from
-start to finish, with no possibility of branching or halting.
-
-It can be used either stand alone or from inside another program.
-
-=for _private
-Somebody who understands the stand-alone options document them, please.
-
-=head2 Functions
-
-=over 4
-
-=item B<find_leaders>
-
-  my $leaders = find_leaders($root_op, $start_op);
-
-Given the root of the op tree and an op from which to start
-processing, it will return a hash ref representing all the ops which
-start a block.
-
-=for _private
-The above description may be somewhat wrong.
-
-The values of %$leaders are the op objects themselves.  Keys are $$op
-addresses.
-
-=for _private
-Above cribbed from B::CC's comments.  What's a $$op address?
-
-=back
-
-
-=head1 AUTHOR
-
-Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
-
-=cut
diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
deleted file mode 100644 (file)
index 4a81abc..0000000
+++ /dev/null
@@ -1,890 +0,0 @@
-# B::Bytecode.pm
-# Copyright (c) 2003 Enache Adrian. All rights reserved.
-# This module is free software; you can redistribute and/or modify
-# 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.02';
-
-use strict;
-use Config;
-use B qw(class main_cv main_root main_start cstring comppadlist
-       defstash curstash begin_av init_av end_av inc_gv warnhook diehook
-       dowarn SVt_PVGV SVt_PVHV OPf_SPECIAL OPf_STACKED OPf_MOD
-       OPpLVAL_INTRO SVf_FAKE SVf_READONLY);
-use B::Asmdata qw(@specialsv_name);
-use B::Assembler qw(asm newasm endasm);
-
-#################################################
-
-my ($varix, $opix, $savebegins, %walked, %files, @cloop);
-my %strtab = (0,0);
-my %svtab = (0,0);
-my %optab = (0,0);
-my %spectab = (0,0);
-my $tix = 1;
-sub asm;
-sub nice ($) { }
-
-BEGIN {
-    my $ithreads = $Config{'useithreads'} eq 'define';
-    eval qq{
-       sub ITHREADS() { $ithreads }
-       sub VERSION() { $] }
-    }; die $@ if $@;
-}
-
-#################################################
-
-sub pvstring {
-    my $pv = shift;
-    defined($pv) ? cstring ($pv."\0") : "\"\"";
-}
-
-sub pvix {
-    my $str = pvstring shift;
-    my $ix = $strtab{$str};
-    defined($ix) ? $ix : do {
-       asm "newpv", $str;
-       asm "stpv", $strtab{$str} = $tix;
-       $tix++;
-    }
-}
-
-sub B::OP::ix {
-    my $op = shift;
-    my $ix = $optab{$$op};
-    defined($ix) ? $ix : do {
-       nice "[".$op->name." $tix]";
-       asm "newopx", $op->size | $op->type <<7;
-       $optab{$$op} = $opix = $ix = $tix++;
-       $op->bsave($ix);
-       $ix;
-    }
-}
-
-sub B::SPECIAL::ix {
-    my $spec = shift;
-    my $ix = $spectab{$$spec};
-    defined($ix) ? $ix : do {
-       nice '['.$specialsv_name[$$spec].']';
-       asm "ldspecsvx", $$spec;
-       $spectab{$$spec} = $varix = $tix++;
-    }
-}
-
-sub B::SV::ix {
-    my $sv = shift;
-    my $ix = $svtab{$$sv};
-    defined($ix) ? $ix : do {
-       nice '['.class($sv).']';
-       asm "newsvx", $sv->FLAGS;
-       $svtab{$$sv} = $varix = $ix = $tix++;
-       $sv->bsave($ix);
-       $ix;
-    }
-}
-
-sub B::GV::ix {
-    my ($gv,$desired) = @_;
-    my $ix = $svtab{$$gv};
-    defined($ix) ? $ix : do {
-       if ($gv->GP) {
-           my ($svix, $avix, $hvix, $cvix, $ioix, $formix);
-           nice "[GV]";
-           my $name = $gv->STASH->NAME . "::" . $gv->NAME;
-           asm "gv_fetchpvx", cstring $name;
-           $svtab{$$gv} = $varix = $ix = $tix++;
-           asm "sv_flags", $gv->FLAGS;
-           asm "sv_refcnt", $gv->REFCNT;
-           asm "xgv_flags", $gv->GvFLAGS;
-
-           asm "gp_refcnt", $gv->GvREFCNT;
-           asm "load_glob", $ix if $name eq "CORE::GLOBAL::glob";
-           return $ix
-                   unless $desired || desired $gv;
-           $svix = $gv->SV->ix;
-           $avix = $gv->AV->ix;
-           $hvix = $gv->HV->ix;
-
-    # XXX {{{{
-           my $cv = $gv->CV;
-           $cvix = $$cv && defined $files{$cv->FILE} ? $cv->ix : 0;
-           my $form = $gv->FORM;
-           $formix = $$form && defined $files{$form->FILE} ? $form->ix : 0;
-
-           $ioix = $name !~ /STDOUT$/ ? $gv->IO->ix : 0;       
-                                                           # }}}} XXX
-
-           nice "-GV-",
-           asm "ldsv", $varix = $ix unless $ix == $varix;
-           asm "gp_sv", $svix;
-           asm "gp_av", $avix;
-           asm "gp_hv", $hvix;
-           asm "gp_cv", $cvix;
-           asm "gp_io", $ioix;
-           asm "gp_cvgen", $gv->CVGEN;
-           asm "gp_form", $formix;
-           asm "gp_file", pvix $gv->FILE;
-           asm "gp_line", $gv->LINE;
-           asm "formfeed", $svix if $name eq "main::\cL";
-       } else {
-           nice "[GV]";
-           asm "newsvx", $gv->FLAGS;
-           $svtab{$$gv} = $varix = $ix = $tix++;
-           my $stashix = $gv->STASH->ix;
-           $gv->B::PVMG::bsave($ix);
-           asm "xgv_flags", $gv->GvFLAGS;
-           asm "xgv_stash", $stashix;
-       }
-       $ix;
-    }
-}
-
-sub B::HV::ix {
-    my $hv = shift;
-    my $ix = $svtab{$$hv};
-    defined($ix) ? $ix : do {
-       my ($ix,$i,@array);
-       my $name = $hv->NAME;
-       if ($name) {
-           nice "[STASH]";
-           asm "gv_stashpvx", cstring $name;
-           asm "sv_flags", $hv->FLAGS;
-           $svtab{$$hv} = $varix = $ix = $tix++;
-           asm "xhv_name", pvix $name;
-           # my $pmrootix = $hv->PMROOT->ix;   # XXX
-           asm "ldsv", $varix = $ix unless $ix == $varix;
-           # asm "xhv_pmroot", $pmrootix;      # XXX
-       } else {
-           nice "[HV]";
-           asm "newsvx", $hv->FLAGS;
-           $svtab{$$hv} = $varix = $ix = $tix++;
-           my $stashix = $hv->SvSTASH->ix;
-           for (@array = $hv->ARRAY) {
-               next if $i = not $i;
-               $_ = $_->ix;
-           }
-           nice "-HV-",
-           asm "ldsv", $varix = $ix unless $ix == $varix;
-           ($i = not $i) ? asm ("newpv", pvstring $_) : asm("hv_store", $_)
-               for @array;
-           if (VERSION < 5.009) {
-               asm "xnv", $hv->NVX;
-           }
-           asm "xmg_stash", $stashix;
-           asm "xhv_riter", $hv->RITER;
-       }
-       asm "sv_refcnt", $hv->REFCNT;
-       $ix;
-    }
-}
-
-sub B::NULL::ix {
-    my $sv = shift;
-    $$sv ? $sv->B::SV::ix : 0;
-}
-
-sub B::NULL::opwalk { 0 }
-
-#################################################
-
-sub B::NULL::bsave {
-    my ($sv,$ix) = @_;
-
-    nice '-'.class($sv).'-',
-    asm "ldsv", $varix = $ix unless $ix == $varix;
-    asm "sv_refcnt", $sv->REFCNT;
-}
-
-sub B::SV::bsave;
-    *B::SV::bsave = *B::NULL::bsave;
-
-sub B::RV::bsave {
-    my ($sv,$ix) = @_;
-    my $rvix = $sv->RV->ix;
-    $sv->B::NULL::bsave($ix);
-    asm "xrv", $rvix;
-}
-
-sub B::PV::bsave {
-    my ($sv,$ix) = @_;
-    $sv->B::NULL::bsave($ix);
-    asm "newpv", pvstring $sv->PVBM;
-    asm "xpv";
-}
-
-sub B::IV::bsave {
-    my ($sv,$ix) = @_;
-    $sv->B::NULL::bsave($ix);
-    asm "xiv", $sv->IVX;
-}
-
-sub B::NV::bsave {
-    my ($sv,$ix) = @_;
-    $sv->B::NULL::bsave($ix);
-    asm "xnv", sprintf "%.40g", $sv->NVX;
-}
-
-sub B::PVIV::bsave {
-    my ($sv,$ix) = @_;
-    $sv->POK ?
-       $sv->B::PV::bsave($ix):
-    $sv->ROK ?
-       $sv->B::RV::bsave($ix):
-       $sv->B::NULL::bsave($ix);
-    if (VERSION >= 5.009) {
-       # See note below in B::PVNV::bsave
-       return if $sv->isa('B::AV');
-       return if $sv->isa('B::HV');
-       return if $sv->isa('B::CV');
-    }
-    asm "xiv", !ITHREADS && $sv->FLAGS & (SVf_FAKE|SVf_READONLY) ?
-       "0 but true" : $sv->IVX;
-}
-
-sub B::PVNV::bsave {
-    my ($sv,$ix) = @_;
-    $sv->B::PVIV::bsave($ix);
-    if (VERSION >= 5.009) {
-       # Magical AVs end up here, but AVs now don't have an NV slot actually
-       # allocated. Hence don't write out assembly to store the NV slot if
-       # we're actually an array.
-       return if $sv->isa('B::AV');
-       # Likewise HVs have no NV slot actually allocated.
-       # I don't think that they can get here, but better safe than sorry
-       return if $sv->isa('B::HV');
-       return if $sv->isa('B::CV');
-       return if $sv->isa('B::FM');
-     }
-    asm "xnv", sprintf "%.40g", $sv->NVX;
-}
-
-sub B::PVMG::domagic {
-    my ($sv,$ix) = @_;
-    nice '-MAGICAL-';
-    my @mglist = $sv->MAGIC;
-    my (@mgix, @namix);
-    for (@mglist) {
-       push @mgix, $_->OBJ->ix;
-       push @namix, $_->PTR->ix if $_->LENGTH == B::HEf_SVKEY;
-    }
-
-    nice '-'.class($sv).'-',
-    asm "ldsv", $varix = $ix unless $ix == $varix;
-    for (@mglist) {
-       asm "sv_magic", cstring $_->TYPE;
-       asm "mg_obj", shift @mgix;
-       my $length = $_->LENGTH;
-       if ($length == B::HEf_SVKEY) {
-           asm "mg_namex", shift @namix;
-       } elsif ($length) {
-           asm "newpv", pvstring $_->PTR;
-           asm "mg_name";
-       }
-    }
-}
-
-sub B::PVMG::bsave {
-    my ($sv,$ix) = @_;
-    my $stashix = $sv->SvSTASH->ix;
-    $sv->B::PVNV::bsave($ix);
-    asm "xmg_stash", $stashix;
-    $sv->domagic($ix) if $sv->MAGICAL;
-}
-
-sub B::PVLV::bsave {
-    my ($sv,$ix) = @_;
-    my $targix = $sv->TARG->ix;
-    $sv->B::PVMG::bsave($ix);
-    asm "xlv_targ", $targix;
-    asm "xlv_targoff", $sv->TARGOFF;
-    asm "xlv_targlen", $sv->TARGLEN;
-    asm "xlv_type", $sv->TYPE;
-
-}
-
-sub B::BM::bsave {
-    my ($sv,$ix) = @_;
-    $sv->B::PVMG::bsave($ix);
-    asm "xpv_cur", $sv->CUR;
-    asm "xbm_useful", $sv->USEFUL;
-    asm "xbm_previous", $sv->PREVIOUS;
-    asm "xbm_rare", $sv->RARE;
-}
-
-sub B::IO::bsave {
-    my ($io,$ix) = @_;
-    my $topix = $io->TOP_GV->ix;
-    my $fmtix = $io->FMT_GV->ix;
-    my $bottomix = $io->BOTTOM_GV->ix;
-    $io->B::PVMG::bsave($ix);
-    asm "xio_lines", $io->LINES;
-    asm "xio_page", $io->PAGE;
-    asm "xio_page_len", $io->PAGE_LEN;
-    asm "xio_lines_left", $io->LINES_LEFT;
-    asm "xio_top_name", pvix $io->TOP_NAME;
-    asm "xio_top_gv", $topix;
-    asm "xio_fmt_name", pvix $io->FMT_NAME;
-    asm "xio_fmt_gv", $fmtix;
-    asm "xio_bottom_name", pvix $io->BOTTOM_NAME;
-    asm "xio_bottom_gv", $bottomix;
-    asm "xio_subprocess", $io->SUBPROCESS;
-    asm "xio_type", ord $io->IoTYPE;
-    # asm "xio_flags", ord($io->IoFLAGS) & ~32;                # XXX XXX
-}
-
-sub B::CV::bsave {
-    my ($cv,$ix) = @_;
-    my $stashix = $cv->STASH->ix;
-    my $gvix = $cv->GV->ix;
-    my $padlistix = $cv->PADLIST->ix;
-    my $outsideix = $cv->OUTSIDE->ix;
-    my $constix = $cv->CONST ? $cv->XSUBANY->ix : 0;
-    my $startix = $cv->START->opwalk;
-    my $rootix = $cv->ROOT->ix;
-
-    $cv->B::PVMG::bsave($ix);
-    asm "xcv_stash", $stashix;
-    asm "xcv_start", $startix;
-    asm "xcv_root", $rootix;
-    asm "xcv_xsubany", $constix;
-    asm "xcv_gv", $gvix;
-    asm "xcv_file", pvix $cv->FILE if $cv->FILE;       # XXX AD
-    asm "xcv_padlist", $padlistix;
-    asm "xcv_outside", $outsideix;
-    asm "xcv_flags", $cv->CvFLAGS;
-    asm "xcv_outside_seq", $cv->OUTSIDE_SEQ;
-    asm "xcv_depth", $cv->DEPTH;
-}
-
-sub B::FM::bsave {
-    my ($form,$ix) = @_;
-
-    $form->B::CV::bsave($ix);
-    asm "xfm_lines", $form->LINES;
-}
-
-sub B::AV::bsave {
-    my ($av,$ix) = @_;
-    return $av->B::PVMG::bsave($ix) if $av->MAGICAL;
-    my @array = $av->ARRAY;
-    $_ = $_->ix for @array;
-    my $stashix = $av->SvSTASH->ix;
-
-    nice "-AV-",
-    asm "ldsv", $varix = $ix unless $ix == $varix;
-    asm "av_extend", $av->MAX if $av->MAX >= 0;
-    asm "av_pushx", $_ for @array;
-    asm "sv_refcnt", $av->REFCNT;
-    if (VERSION < 5.009) {
-       asm "xav_flags", $av->AvFLAGS;
-    }
-    asm "xmg_stash", $stashix;
-}
-
-sub B::GV::desired {
-    my $gv = shift;
-    my ($cv, $form);
-    $files{$gv->FILE} && $gv->LINE
-    || ${$cv = $gv->CV} && $files{$cv->FILE}
-    || ${$form = $gv->FORM} && $files{$form->FILE}
-}
-
-sub B::HV::bwalk {
-    my $hv = shift;
-    return if $walked{$$hv}++;
-    my %stash = $hv->ARRAY;
-    while (my($k,$v) = each %stash) {
-       if ($v->SvTYPE == SVt_PVGV) {
-           my $hash = $v->HV;
-           if ($$hash && $hash->NAME) {
-               $hash->bwalk;
-           } 
-           $v->ix(1) if desired $v;
-       } else {
-           nice "[prototype]";
-           asm "gv_fetchpvx", cstring $hv->NAME . "::$k";
-           $svtab{$$v} = $varix = $tix;
-           $v->bsave($tix++);
-           asm "sv_flags", $v->FLAGS;
-       }
-    }
-}
-
-######################################################
-
-
-sub B::OP::bsave_thin {
-    my ($op, $ix) = @_;
-    my $next = $op->next;
-    my $nextix = $optab{$$next};
-    $nextix = 0, push @cloop, $op unless defined $nextix;
-    if ($ix != $opix) {
-       nice '-'.$op->name.'-',
-       asm "ldop", $opix = $ix;
-    }
-    asm "op_next", $nextix;
-    asm "op_targ", $op->targ if $op->type;             # tricky
-    asm "op_flags", $op->flags;
-    asm "op_private", $op->private;
-}
-
-sub B::OP::bsave;
-    *B::OP::bsave = *B::OP::bsave_thin;
-
-sub B::UNOP::bsave {
-    my ($op, $ix) = @_;
-    my $name = $op->name;
-    my $flags = $op->flags;
-    my $first = $op->first;
-    my $firstix = 
-       $name =~ /fl[io]p/
-                       # that's just neat
-    || (!ITHREADS && $name eq 'regcomp')
-                       # trick for /$a/o in pp_regcomp
-    || $name eq 'rv2sv'
-           && $op->flags & OPf_MOD     
-           && $op->private & OPpLVAL_INTRO
-                       # change #18774 made my life hard
-    ?  $first->ix
-    :  0;
-
-    $op->B::OP::bsave($ix);
-    asm "op_first", $firstix;
-}
-
-sub B::BINOP::bsave {
-    my ($op, $ix) = @_;
-    if ($op->name eq 'aassign' && $op->private & B::OPpASSIGN_HASH()) {
-       my $last = $op->last;
-       my $lastix = do {
-           local *B::OP::bsave = *B::OP::bsave_fat;
-           local *B::UNOP::bsave = *B::UNOP::bsave_fat;
-           $last->ix;
-       };
-       asm "ldop", $lastix unless $lastix == $opix;
-       asm "op_targ", $last->targ;
-       $op->B::OP::bsave($ix);
-       asm "op_last", $lastix;
-    } else {
-       $op->B::OP::bsave($ix);
-    }
-}
-
-# not needed if no pseudohashes
-
-*B::BINOP::bsave = *B::OP::bsave if VERSION >= 5.009;
-
-# deal with sort / formline 
-
-sub B::LISTOP::bsave {
-    my ($op, $ix) = @_;
-    my $name = $op->name;
-    sub blocksort() { OPf_SPECIAL|OPf_STACKED }
-    if ($name eq 'sort' && ($op->flags & blocksort) == blocksort) {
-       my $first = $op->first;
-       my $pushmark = $first->sibling;
-       my $rvgv = $pushmark->first;
-       my $leave = $rvgv->first;
-
-       my $leaveix = $leave->ix;
-
-       my $rvgvix = $rvgv->ix;
-       asm "ldop", $rvgvix unless $rvgvix == $opix;
-       asm "op_first", $leaveix;
-
-       my $pushmarkix = $pushmark->ix;
-       asm "ldop", $pushmarkix unless $pushmarkix == $opix;
-       asm "op_first", $rvgvix;
-
-       my $firstix = $first->ix;
-       asm "ldop", $firstix unless $firstix == $opix;
-       asm "op_sibling", $pushmarkix;
-
-       $op->B::OP::bsave($ix);
-       asm "op_first", $firstix;
-    } elsif ($name eq 'formline') {
-       $op->B::UNOP::bsave_fat($ix);
-    } else {
-       $op->B::OP::bsave($ix);
-    }
-}
-
-# fat versions
-
-sub B::OP::bsave_fat {
-    my ($op, $ix) = @_;
-    my $siblix = $op->sibling->ix;
-
-    $op->B::OP::bsave_thin($ix);
-    asm "op_sibling", $siblix;
-    # asm "op_seq", -1;                        XXX don't allocate OPs piece by piece
-}
-
-sub B::UNOP::bsave_fat {
-    my ($op,$ix) = @_;
-    my $firstix = $op->first->ix;
-
-    $op->B::OP::bsave($ix);
-    asm "op_first", $firstix;
-}
-
-sub B::BINOP::bsave_fat {
-    my ($op,$ix) = @_;
-    my $last = $op->last;
-    my $lastix = $op->last->ix;
-    if (VERSION < 5.009 && $op->name eq 'aassign' && $last->name eq 'null') {
-       asm "ldop", $lastix unless $lastix == $opix;
-       asm "op_targ", $last->targ;
-    }
-
-    $op->B::UNOP::bsave($ix);
-    asm "op_last", $lastix;
-}
-
-sub B::LOGOP::bsave {
-    my ($op,$ix) = @_;
-    my $otherix = $op->other->ix;
-
-    $op->B::UNOP::bsave($ix);
-    asm "op_other", $otherix;
-}
-
-sub B::PMOP::bsave {
-    my ($op,$ix) = @_;
-    my ($rrop, $rrarg, $rstart);
-
-    # my $pmnextix = $op->pmnext->ix;  # XXX
-
-    if (ITHREADS) {
-       if ($op->name eq 'subst') {
-           $rrop = "op_pmreplroot";
-           $rrarg = $op->pmreplroot->ix;
-           $rstart = $op->pmreplstart->ix;
-       } elsif ($op->name eq 'pushre') {
-           $rrop = "op_pmreplrootpo";
-           $rrarg = $op->pmreplroot;
-       }
-       $op->B::BINOP::bsave($ix);
-       asm "op_pmstashpv", pvix $op->pmstashpv;
-    } else {
-       $rrop = "op_pmreplrootgv";
-       $rrarg = $op->pmreplroot->ix;
-       $rstart = $op->pmreplstart->ix if $op->name eq 'subst';
-       my $stashix = $op->pmstash->ix;
-       $op->B::BINOP::bsave($ix);
-       asm "op_pmstash", $stashix;
-    }
-
-    asm $rrop, $rrarg if $rrop;
-    asm "op_pmreplstart", $rstart if $rstart;
-
-    asm "op_pmflags", $op->pmflags;
-    asm "op_pmpermflags", $op->pmpermflags;
-    asm "op_pmdynflags", $op->pmdynflags;
-    # asm "op_pmnext", $pmnextix;      # XXX
-    asm "newpv", pvstring $op->precomp;
-    asm "pregcomp";
-}
-
-sub B::SVOP::bsave {
-    my ($op,$ix) = @_;
-    my $svix = $op->sv->ix;
-
-    $op->B::OP::bsave($ix);
-    asm "op_sv", $svix;
-}
-
-sub B::PADOP::bsave {
-    my ($op,$ix) = @_;
-
-    $op->B::OP::bsave($ix);
-    asm "op_padix", $op->padix;
-}
-
-sub B::PVOP::bsave {
-    my ($op,$ix) = @_;
-    $op->B::OP::bsave($ix);
-    return unless my $pv = $op->pv;
-
-    if ($op->name eq 'trans') {
-        asm "op_pv_tr", join ',', length($pv)/2, unpack("s*", $pv);
-    } else {
-        asm "newpv", pvstring $pv;
-        asm "op_pv";
-    }
-}
-
-sub B::LOOP::bsave {
-    my ($op,$ix) = @_;
-    my $nextix = $op->nextop->ix;
-    my $lastix = $op->lastop->ix;
-    my $redoix = $op->redoop->ix;
-
-    $op->B::BINOP::bsave($ix);
-    asm "op_redoop", $redoix;
-    asm "op_nextop", $nextix;
-    asm "op_lastop", $lastix;
-}
-
-sub B::COP::bsave {
-    my ($cop,$ix) = @_;
-    my $warnix = $cop->warnings->ix;
-    if (ITHREADS) {
-       $cop->B::OP::bsave($ix);
-       asm "cop_stashpv", pvix $cop->stashpv;
-       asm "cop_file", pvix $cop->file;
-    } else {
-       my $stashix = $cop->stash->ix;
-       my $fileix = $cop->filegv->ix(1);
-       $cop->B::OP::bsave($ix);
-       asm "cop_stash", $stashix;
-       asm "cop_filegv", $fileix;
-    }
-    asm "cop_label", pvix $cop->label if $cop->label;  # XXX AD
-    asm "cop_seq", $cop->cop_seq;
-    asm "cop_arybase", $cop->arybase;
-    asm "cop_line", $cop->line;
-    asm "cop_warnings", $warnix;
-}
-
-sub B::OP::opwalk {
-    my $op = shift;
-    my $ix = $optab{$$op};
-    defined($ix) ? $ix : do {
-       my $ix;
-       my @oplist = $op->oplist;
-       push @cloop, undef;
-       $ix = $_->ix while $_ = pop @oplist;
-       while ($_ = pop @cloop) {
-           asm "ldop", $optab{$$_};
-           asm "op_next", $optab{${$_->next}};
-       }
-       $ix;
-    }
-}
-
-#################################################
-
-sub save_cq {
-    my $av;
-    if (($av=begin_av)->isa("B::AV")) {
-       if ($savebegins) {
-           for ($av->ARRAY) {
-               next unless $_->FILE eq $0;
-               asm "push_begin", $_->ix;
-           }
-       } else {
-           for ($av->ARRAY) {
-               next unless $_->FILE eq $0;
-               # XXX BEGIN { goto A while 1; A: }
-               for (my $op = $_->START; $$op; $op = $op->next) {
-                   next unless $op->name eq 'require' || 
-                       # this kludge needed for tests
-                       $op->name eq 'gv' && do {
-                           my $gv = class($op) eq 'SVOP' ?
-                               $op->gv :
-                               (($_->PADLIST->ARRAY)[1]->ARRAY)[$op->padix];
-                           $$gv && $gv->NAME =~ /use_ok|plan/
-                       };
-                   asm "push_begin", $_->ix;
-                   last;
-               }
-           }
-       }
-    }
-    if (($av=init_av)->isa("B::AV")) {
-       for ($av->ARRAY) {
-           next unless $_->FILE eq $0;
-           asm "push_init", $_->ix;
-       }
-    }
-    if (($av=end_av)->isa("B::AV")) {
-       for ($av->ARRAY) {
-           next unless $_->FILE eq $0;
-           asm "push_end", $_->ix;
-       }
-    }
-}
-
-sub compile {
-    my ($head, $scan, $T_inhinc, $keep_syn);
-    my $cwd = '';
-    $files{$0} = 1;
-    sub keep_syn {
-       $keep_syn = 1;
-       *B::OP::bsave = *B::OP::bsave_fat;
-       *B::UNOP::bsave = *B::UNOP::bsave_fat;
-       *B::BINOP::bsave = *B::BINOP::bsave_fat;
-       *B::LISTOP::bsave = *B::LISTOP::bsave_fat;
-    }
-    sub bwarn { print STDERR "Bytecode.pm: @_\n" }
-
-    for (@_) {
-       if (/^-S/) {
-           *newasm = *endasm = sub { };
-           *asm = sub { print "    @_\n" };
-           *nice = sub ($) { print "\n@_\n" };
-       } elsif (/^-H/) {
-           require ByteLoader;
-           $head = "#! $^X\nuse ByteLoader $ByteLoader::VERSION;\n";
-       } elsif (/^-k/) {
-           keep_syn;
-       } elsif (/^-o(.*)$/) {
-           open STDOUT, ">$1" or die "open $1: $!";
-       } elsif (/^-f(.*)$/) {
-           $files{$1} = 1;
-       } elsif (/^-s(.*)$/) {
-           $scan = length($1) ? $1 : $0;
-       } elsif (/^-b/) {
-           $savebegins = 1;
-    # this is here for the testsuite
-       } elsif (/^-TI/) {
-           $T_inhinc = 1;
-       } elsif (/^-TF(.*)/) {
-           my $thatfile = $1;
-           *B::COP::file = sub { $thatfile };
-       } 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;
-               if (/\bgoto\b\s*[^&]/ && !$keep_syn) {
-                   bwarn "keeping the syntax tree: \"goto\" op found";
-                   keep_syn;
-               }
-           }
-       } else {
-           bwarn "cannot rescan '$scan'";
-       }
-       close $f;
-    }
-    binmode STDOUT;
-    return sub {
-       print $head if $head;
-       newasm sub { print @_ };
-
-       defstash->bwalk;
-       asm "main_start", main_start->opwalk;
-       asm "main_root", main_root->ix;
-       asm "main_cv", main_cv->ix;
-       asm "curpad", (comppadlist->ARRAY)[1]->ix;
-
-       asm "signal", cstring "__WARN__"                # XXX
-           if warnhook->ix;
-       asm "incav", inc_gv->AV->ix if $T_inhinc;
-       save_cq;
-       asm "incav", inc_gv->AV->ix if $T_inhinc;
-       asm "dowarn", dowarn;
-
-       {
-           no strict 'refs';
-           nice "<DATA>";
-           my $dh = *{defstash->NAME."::DATA"};
-           unless (eof $dh) {
-               local undef $/;
-               asm "data", ord 'D';
-               print <$dh>;
-           } else {
-               asm "ret";
-           }
-       }
-
-       endasm;
-    }
-}
-
-1;
-
-=head1 NAME
-
-B::Bytecode - Perl compiler's bytecode backend
-
-=head1 SYNOPSIS
-
-B<perl -MO=Bytecode>[B<,-H>][B<,-o>I<script.plc>] I<script.pl>
-
-=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
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
deleted file mode 100644 (file)
index 17ca257..0000000
+++ /dev/null
@@ -1,2236 +0,0 @@
-#      C.pm
-#
-#      Copyright (c) 1996, 1997, 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::C;
-
-our $VERSION = '1.05';
-
-package B::C::Section;
-
-use B ();
-use base B::Section;
-
-sub new
-{
- my $class = shift;
- my $o = $class->SUPER::new(@_);
- push @$o, { values => [] };
- return $o;
-}
-
-sub add
-{
- my $section = shift;
- push(@{$section->[-1]{values}},@_);
-}
-
-sub index
-{
- my $section = shift;
- return scalar(@{$section->[-1]{values}})-1;
-}
-
-sub output
-{
- my ($section, $fh, $format) = @_;
- my $sym = $section->symtable || {};
- my $default = $section->default;
- my $i;
- foreach (@{$section->[-1]{values}})
-  {
-   s{(s\\_[0-9a-f]+)}{ exists($sym->{$1}) ? $sym->{$1} : $default; }ge;
-   printf $fh $format, $_, $i;
-   ++$i;
-  }
-}
-
-package B::C::InitSection;
-
-# avoid use vars
-@B::C::InitSection::ISA = qw(B::C::Section);
-
-sub new {
-    my $class = shift;
-    my $max_lines = 10000; #pop;
-    my $section = $class->SUPER::new( @_ );
-
-    $section->[-1]{evals} = [];
-    $section->[-1]{chunks} = [];
-    $section->[-1]{nosplit} = 0;
-    $section->[-1]{current} = [];
-    $section->[-1]{count} = 0;
-    $section->[-1]{max_lines} = $max_lines;
-
-    return $section;
-}
-
-sub split {
-    my $section = shift;
-    $section->[-1]{nosplit}--
-      if $section->[-1]{nosplit} > 0;
-}
-
-sub no_split {
-    shift->[-1]{nosplit}++;
-}
-
-sub inc_count {
-    my $section = shift;
-
-    $section->[-1]{count} += $_[0];
-    # this is cheating
-    $section->add();
-}
-
-sub add {
-    my $section = shift->[-1];
-    my $current = $section->{current};
-    my $nosplit = $section->{nosplit};
-
-    push @$current, @_;
-    $section->{count} += scalar(@_);
-    if( !$nosplit && $section->{count} >= $section->{max_lines} ) {
-        push @{$section->{chunks}}, $current;
-        $section->{current} = [];
-        $section->{count} = 0;
-    }
-}
-
-sub add_eval {
-    my $section = shift;
-    my @strings = @_;
-
-    foreach my $i ( @strings ) {
-        $i =~ s/\"/\\\"/g;
-    }
-    push @{$section->[-1]{evals}}, @strings;
-}
-
-sub output {
-    my( $section, $fh, $format, $init_name ) = @_;
-    my $sym = $section->symtable || {};
-    my $default = $section->default;
-    push @{$section->[-1]{chunks}}, $section->[-1]{current};
-
-    my $name = "aaaa";
-    foreach my $i ( @{$section->[-1]{chunks}} ) {
-        print $fh <<"EOT";
-static int perl_init_${name}()
-{
-       dTARG;
-       dSP;
-EOT
-        foreach my $j ( @$i ) {
-            $j =~ s{(s\\_[0-9a-f]+)}
-                   { exists($sym->{$1}) ? $sym->{$1} : $default; }ge;
-            print $fh "\t$j\n";
-        }
-        print $fh "\treturn 0;\n}\n";
-
-        $section->SUPER::add( "perl_init_${name}();" );
-        ++$name;
-    }
-    foreach my $i ( @{$section->[-1]{evals}} ) {
-        $section->SUPER::add( sprintf q{eval_pv("%s",1);}, $i );
-    }
-
-    print $fh <<"EOT";
-static int ${init_name}()
-{
-       dTARG;
-       dSP;
-EOT
-    $section->SUPER::output( $fh, $format );
-    print $fh "\treturn 0;\n}\n";
-}
-
-
-package B::C;
-use Exporter ();
-our %REGEXP;
-
-{ # block necessary for caller to work
-    my $caller = caller;
-    if( $caller eq 'O' ) {
-        require XSLoader;
-        XSLoader::load( 'B::C' );
-    }
-}
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(output_all output_boilerplate output_main mark_unused
-               init_sections set_callback save_unused_subs objsym save_context);
-
-use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
-        class cstring cchar svref_2object compile_stats comppadlist hash
-        threadsv_names main_cv init_av end_av regex_padav opnumber amagic_generation
-        HEf_SVKEY SVf_POK SVf_ROK CVf_CONST);
-use B::Asmdata qw(@specialsv_name);
-
-use FileHandle;
-use Carp;
-use strict;
-use Config;
-
-my $hv_index = 0;
-my $gv_index = 0;
-my $re_index = 0;
-my $pv_index = 0;
-my $cv_index = 0;
-my $anonsub_index = 0;
-my $initsub_index = 0;
-
-my %symtable;
-my %xsub;
-my $warn_undefined_syms;
-my $verbose;
-my %unused_sub_packages;
-my $use_xsloader;
-my $nullop_count;
-my $pv_copy_on_grow = 0;
-my $optimize_ppaddr = 0;
-my $optimize_warn_sv = 0;
-my $use_perl_script_name = 0;
-my $save_data_fh = 0;
-my $save_sig = 0;
-my ($debug_cops, $debug_av, $debug_cv, $debug_mg);
-my $max_string_len;
-
-my $ithreads = $Config{useithreads} eq 'define';
-
-my @threadsv_names;
-BEGIN {
-    @threadsv_names = threadsv_names();
-}
-
-# Code sections
-my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect, 
-    $padopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
-    $pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect,
-    $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect,
-    $xrvsect, $xpvbmsect, $xpviosect );
-my @op_sections = \( $binopsect, $condopsect, $copsect, $padopsect, $listopsect,
-                     $logopsect, $loopsect, $opsect, $pmopsect, $pvopsect, $svopsect,
-                     $unopsect );
-
-sub walk_and_save_optree;
-my $saveoptree_callback = \&walk_and_save_optree;
-sub set_callback { $saveoptree_callback = shift }
-sub saveoptree { &$saveoptree_callback(@_) }
-
-sub walk_and_save_optree {
-    my ($name, $root, $start) = @_;
-    walkoptree($root, "save");
-    return objsym($start);
-}
-
-# Look this up here so we can do just a number compare
-# rather than looking up the name of every BASEOP in B::OP
-my $OP_THREADSV = opnumber('threadsv');
-
-sub savesym {
-    my ($obj, $value) = @_;
-    my $sym = sprintf("s\\_%x", $$obj);
-    $symtable{$sym} = $value;
-}
-
-sub objsym {
-    my $obj = shift;
-    return $symtable{sprintf("s\\_%x", $$obj)};
-}
-
-sub getsym {
-    my $sym = shift;
-    my $value;
-
-    return 0 if $sym eq "sym_0";       # special case
-    $value = $symtable{$sym};
-    if (defined($value)) {
-       return $value;
-    } else {
-       warn "warning: undefined symbol $sym\n" if $warn_undefined_syms;
-       return "UNUSED";
-    }
-}
-
-sub savere {
-    my $re = shift;
-    my $sym = sprintf("re%d", $re_index++);
-    $decl->add(sprintf("static char *$sym = %s;", cstring($re)));
-
-    return ($sym,length(pack "a*",$re));
-}
-
-sub savepv {
-    my $pv = pack "a*", shift;
-    my $pvsym = 0;
-    my $pvmax = 0;
-    if ($pv_copy_on_grow) {
-        $pvsym = sprintf("pv%d", $pv_index++);
-
-        if( defined $max_string_len && length($pv) > $max_string_len ) {
-            my $chars = join ', ', map { cchar $_ } split //, $pv;
-            $decl->add(sprintf("static char %s[] = { %s };", $pvsym, $chars));
-        }
-        else {
-            my $cstring = cstring($pv);
-            if ($cstring ne "0") { # sic
-                $decl->add(sprintf("static char %s[] = %s;",
-                                   $pvsym, $cstring));
-           }
-        }
-    } else {
-       $pvmax = length(pack "a*",$pv) + 1;
-    }
-    return ($pvsym, $pvmax);
-}
-
-sub save_rv {
-    my $sv = shift;
-#    confess "Can't save RV: not ROK" unless $sv->FLAGS & SVf_ROK;
-    my $rv = $sv->RV->save;
-
-    $rv =~ s/^\(([AGHS]V|IO)\s*\*\)\s*(\&sv_list.*)$/$2/;
-
-    return $rv;
-}
-
-# savesym, pvmax, len, pv
-sub save_pv_or_rv {
-    my $sv = shift;
-
-    my $rok = $sv->FLAGS & SVf_ROK;
-    my $pok = $sv->FLAGS & SVf_POK;
-    my( $len, $pvmax, $savesym, $pv ) = ( 0, 0 );
-    if( $rok ) {
-       $savesym = '(char*)' . save_rv( $sv );
-    }
-    else {
-       $pv = $pok ? (pack "a*", $sv->PV) : undef;
-       $len = $pok ? length($pv) : 0;
-       ($savesym, $pvmax) = $pok ? savepv($pv) : ( 'NULL', 0 );
-    }
-
-    return ( $savesym, $pvmax, $len, $pv );
-}
-
-# see also init_op_ppaddr below; initializes the ppaddt to the
-# OpTYPE; init_op_ppaddr iterates over the ops and sets
-# op_ppaddr to PL_ppaddr[op_ppaddr]; this avoids an explicit assignmente
-# in perl_init ( ~10 bytes/op with GCC/i386 )
-sub B::OP::fake_ppaddr {
-    return $optimize_ppaddr ?
-      sprintf("INT2PTR(void*,OP_%s)", uc( $_[0]->name ) ) :
-      'NULL';
-}
-
-# This pair is needed becase B::FAKEOP::save doesn't scalar dereference
-# $op->next and $op->sibling
-
-{
-  # For 5.9 the hard coded text is the values for op_opt and op_static in each
-  # op.  The value of op_opt is irrelevant, and the value of op_static needs to
-  # be 1 to tell op_free that this is a statically defined op and that is
-  # shouldn't be freed.
-
-  # For 5.8:
-  # Current workaround/fix for op_free() trying to free statically
-  # defined OPs is to set op_seq = -1 and check for that in op_free().
-  # Instead of hardwiring -1 in place of $op->seq, we use $op_seq
-  # so that it can be changed back easily if necessary. In fact, to
-  # stop compilers from moaning about a U16 being initialised with an
-  # uncast -1 (the printf format is %d so we can't tweak it), we have
-  # to "know" that op_seq is a U16 and use 65535. Ugh.
-
-  my $static = $] > 5.009 ? '0, 1, 0' : sprintf "%u", 65535;
-  sub B::OP::_save_common_middle {
-    my $op = shift;
-    sprintf ("%s, %u, %u, $static, 0x%x, 0x%x",
-            $op->fake_ppaddr, $op->targ, $op->type, $op->flags, $op->private);
-  }
-}
-
-sub B::OP::_save_common {
- my $op = shift;
- return sprintf("s\\_%x, s\\_%x, %s",
-               ${$op->next}, ${$op->sibling}, $op->_save_common_middle);
-}
-
-sub B::OP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    my $type = $op->type;
-    $nullop_count++ unless $type;
-    if ($type == $OP_THREADSV) {
-       # saves looking up ppaddr but it's a bit naughty to hard code this
-       $init->add(sprintf("(void)find_threadsv(%s);",
-                          cstring($threadsv_names[$op->targ])));
-    }
-    $opsect->add($op->_save_common);
-    my $ix = $opsect->index;
-    $init->add(sprintf("op_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-    savesym($op, "&op_list[$ix]");
-}
-
-sub B::FAKEOP::new {
-    my ($class, %objdata) = @_;
-    bless \%objdata, $class;
-}
-
-sub B::FAKEOP::save {
-    my ($op, $level) = @_;
-    $opsect->add(sprintf("%s, %s, %s",
-                        $op->next, $op->sibling, $op->_save_common_middle));
-    my $ix = $opsect->index;
-    $init->add(sprintf("op_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-    return "&op_list[$ix]";
-}
-
-sub B::FAKEOP::next { $_[0]->{"next"} || 0 }
-sub B::FAKEOP::type { $_[0]->{type} || 0}
-sub B::FAKEOP::sibling { $_[0]->{sibling} || 0 }
-sub B::FAKEOP::ppaddr { $_[0]->{ppaddr} || 0 }
-sub B::FAKEOP::targ { $_[0]->{targ} || 0 }
-sub B::FAKEOP::flags { $_[0]->{flags} || 0 }
-sub B::FAKEOP::private { $_[0]->{private} || 0 }
-
-sub B::UNOP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    $unopsect->add(sprintf("%s, s\\_%x", $op->_save_common, ${$op->first}));
-    my $ix = $unopsect->index;
-    $init->add(sprintf("unop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-    savesym($op, "(OP*)&unop_list[$ix]");
-}
-
-sub B::BINOP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    $binopsect->add(sprintf("%s, s\\_%x, s\\_%x",
-                           $op->_save_common, ${$op->first}, ${$op->last}));
-    my $ix = $binopsect->index;
-    $init->add(sprintf("binop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-    savesym($op, "(OP*)&binop_list[$ix]");
-}
-
-sub B::LISTOP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    $listopsect->add(sprintf("%s, s\\_%x, s\\_%x",
-                            $op->_save_common, ${$op->first}, ${$op->last}));
-    my $ix = $listopsect->index;
-    $init->add(sprintf("listop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-    savesym($op, "(OP*)&listop_list[$ix]");
-}
-
-sub B::LOGOP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    $logopsect->add(sprintf("%s, s\\_%x, s\\_%x",
-                           $op->_save_common, ${$op->first}, ${$op->other}));
-    my $ix = $logopsect->index;
-    $init->add(sprintf("logop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-    savesym($op, "(OP*)&logop_list[$ix]");
-}
-
-sub B::LOOP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    #warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n",
-    #           peekop($op->redoop), peekop($op->nextop),
-    #           peekop($op->lastop)); # debug
-    $loopsect->add(sprintf("%s, s\\_%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x",
-                          $op->_save_common, ${$op->first}, ${$op->last},
-                          ${$op->redoop}, ${$op->nextop},
-                          ${$op->lastop}));
-    my $ix = $loopsect->index;
-    $init->add(sprintf("loop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-    savesym($op, "(OP*)&loop_list[$ix]");
-}
-
-sub B::PVOP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    $pvopsect->add(sprintf("%s, %s", $op->_save_common, cstring($op->pv)));
-    my $ix = $pvopsect->index;
-    $init->add(sprintf("pvop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-    savesym($op, "(OP*)&pvop_list[$ix]");
-}
-
-sub B::SVOP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    my $sv = $op->sv;
-    my $svsym = '(SV*)' . $sv->save;
-    my $is_const_addr = $svsym =~ m/Null|\&/;
-    $svopsect->add(sprintf("%s, %s", $op->_save_common,
-                          ( $is_const_addr ? $svsym : 'Nullsv' )));
-    my $ix = $svopsect->index;
-    $init->add(sprintf("svop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-    $init->add("svop_list[$ix].op_sv = $svsym;")
-        unless $is_const_addr;
-    savesym($op, "(OP*)&svop_list[$ix]");
-}
-
-sub B::PADOP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    $padopsect->add(sprintf("%s, %d",
-                           $op->_save_common, $op->padix));
-    my $ix = $padopsect->index;
-    $init->add(sprintf("padop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-#    $init->add(sprintf("padop_list[$ix].op_padix = %ld;", $op->padix));
-    savesym($op, "(OP*)&padop_list[$ix]");
-}
-
-sub B::COP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    warn sprintf("COP: line %d file %s\n", $op->line, $op->file)
-       if $debug_cops;
-    # shameless cut'n'paste from B::Deparse
-    my $warn_sv;
-    my $warnings = $op->warnings;
-    my $is_special = $warnings->isa("B::SPECIAL");
-    if ($is_special && $$warnings == 4) {
-        # use warnings 'all';
-        $warn_sv = $optimize_warn_sv ?
-            'INT2PTR(SV*,1)' :
-            'pWARN_ALL';
-    }
-    elsif ($is_special && $$warnings == 5) {
-        # no warnings 'all';
-        $warn_sv = $optimize_warn_sv ?
-            'INT2PTR(SV*,2)' :
-            'pWARN_NONE';
-    }
-    elsif ($is_special) {
-        # use warnings;
-        $warn_sv = $optimize_warn_sv ?
-            'INT2PTR(SV*,3)' :
-            'pWARN_STD';
-    }
-    else {
-        # something else
-        $warn_sv = $warnings->save;
-    }
-
-    $copsect->add(sprintf("%s, %s, NULL, NULL, %u, %d, %u, %s",
-                         $op->_save_common, cstring($op->label), $op->cop_seq,
-                         $op->arybase, $op->line,
-                          ( $optimize_warn_sv ? $warn_sv : 'NULL' )));
-    my $ix = $copsect->index;
-    $init->add(sprintf("cop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
-        unless $optimize_ppaddr;
-    $init->add(sprintf("cop_list[$ix].cop_warnings = %s;", $warn_sv ))
-        unless $optimize_warn_sv;
-    $init->add(sprintf("CopFILE_set(&cop_list[$ix], %s);", cstring($op->file)),
-              sprintf("CopSTASHPV_set(&cop_list[$ix], %s);", cstring($op->stashpv)));
-
-    savesym($op, "(OP*)&cop_list[$ix]");
-}
-
-sub B::PMOP::save {
-    my ($op, $level) = @_;
-    my $sym = objsym($op);
-    return $sym if defined $sym;
-    my $replroot = $op->pmreplroot;
-    my $replstart = $op->pmreplstart;
-    my $replrootfield;
-    my $replstartfield = sprintf("s\\_%x", $$replstart);
-    my $gvsym;
-    my $ppaddr = $op->ppaddr;
-    # under ithreads, OP_PUSHRE.op_replroot is an integer
-    $replrootfield = sprintf("s\\_%x", $$replroot) if ref $replroot;
-    if($ithreads && $op->name eq "pushre") {
-        $replrootfield = "INT2PTR(OP*,${replroot})";
-    } elsif ($$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 ($op->name eq "pushre") {
-           $gvsym = $replroot->save;
-#          warn "PMOP::save saving a pp_pushre with GV $gvsym\n"; # debug
-           $replrootfield = 0;
-       } else {
-           $replstartfield = saveoptree("*ignore*", $replroot, $replstart);
-       }
-    }
-    # pmnext handling is broken in perl itself, I think. Bad op_pmnext
-    # fields aren't noticed in perl's runtime (unless you try reset) but we
-    # segfault when trying to dereference it to find op->op_pmnext->op_type
-    $pmopsect->add(sprintf("%s, s\\_%x, s\\_%x, %s, %s, 0, %u, 0x%x, 0x%x, 0x%x",
-                          $op->_save_common, ${$op->first}, ${$op->last},
-                          $replrootfield, $replstartfield,
-                           ( $ithreads ? $op->pmoffset : 0 ),
-                          $op->pmflags, $op->pmpermflags, $op->pmdynflags ));
-    my $pm = sprintf("pmop_list[%d]", $pmopsect->index);
-    $init->add(sprintf("$pm.op_ppaddr = %s;", $ppaddr))
-        unless $optimize_ppaddr;
-    my $re = $op->precomp;
-    if (defined($re)) {
-       my( $resym, $relen ) = savere( $re );
-       $init->add(sprintf("PM_SETRE(&$pm,pregcomp($resym, $resym + %u, &$pm));",
-                          $relen));
-    }
-    if ($gvsym) {
-       $init->add("$pm.op_pmreplroot = (OP*)$gvsym;");
-    }
-    savesym($op, "(OP*)&$pm");
-}
-
-sub B::SPECIAL::save {
-    my ($sv) = @_;
-    # special case: $$sv is not the address but an index into specialsv_list
-#   warn "SPECIAL::save specialsv $$sv\n"; # debug
-    my $sym = $specialsv_name[$$sv];
-    if (!defined($sym)) {
-       confess "unknown specialsv index $$sv passed to B::SPECIAL::save";
-    }
-    return $sym;
-}
-
-sub B::OBJECT::save {}
-
-sub B::NULL::save {
-    my ($sv) = @_;
-    my $sym = objsym($sv);
-    return $sym if defined $sym;
-#   warn "Saving SVt_NULL SV\n"; # debug
-    # debug
-    if ($$sv == 0) {
-       warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n";
-       return savesym($sv, "(void*)Nullsv /* XXX */");
-    }
-    $svsect->add(sprintf("0, %u, 0x%x", $sv->REFCNT , $sv->FLAGS));
-    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
-}
-
-sub B::IV::save {
-    my ($sv) = @_;
-    my $sym = objsym($sv);
-    return $sym if defined $sym;
-    $xpvivsect->add(sprintf("0, 0, 0, %d", $sv->IVX));
-    $svsect->add(sprintf("&xpviv_list[%d], %lu, 0x%x",
-                        $xpvivsect->index, $sv->REFCNT , $sv->FLAGS));
-    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
-}
-
-sub B::NV::save {
-    my ($sv) = @_;
-    my $sym = objsym($sv);
-    return $sym if defined $sym;
-    my $val= $sv->NVX;
-    $val .= '.00' if $val =~ /^-?\d+$/;
-    $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $val));
-    $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
-                        $xpvnvsect->index, $sv->REFCNT , $sv->FLAGS));
-    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
-}
-
-sub savepvn {
-    my ($dest,$pv) = @_;
-    my @res;
-    # work with byte offsets/lengths
-    my $pv = pack "a*", $pv;
-    if (defined $max_string_len && length($pv) > $max_string_len) {
-       push @res, sprintf("Newx(%s,%u,char);", $dest, length($pv)+1);
-       my $offset = 0;
-       while (length $pv) {
-           my $str = substr $pv, 0, $max_string_len, '';
-           push @res, sprintf("Copy(%s,$dest+$offset,%u,char);",
-                              cstring($str), length($str));
-           $offset += length $str;
-       }
-       push @res, sprintf("%s[%u] = '\\0';", $dest, $offset);
-    }
-    else {
-       push @res, sprintf("%s = savepvn(%s, %u);", $dest,
-                          cstring($pv), length($pv));
-    }
-    return @res;
-}
-
-sub B::PVLV::save {
-    my ($sv) = @_;
-    my $sym = objsym($sv);
-    return $sym if defined $sym;
-    my $pv = $sv->PV;
-    my $len = length($pv);
-    my ($pvsym, $pvmax) = savepv($pv);
-    my ($lvtarg, $lvtarg_sym);
-    $xpvlvsect->add(sprintf("%s, %u, %u, %d, %g, 0, 0, %u, %u, 0, %s",
-                           $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX, 
-                           $sv->TARGOFF, $sv->TARGLEN, cchar($sv->TYPE)));
-    $svsect->add(sprintf("&xpvlv_list[%d], %lu, 0x%x",
-                        $xpvlvsect->index, $sv->REFCNT , $sv->FLAGS));
-    if (!$pv_copy_on_grow) {
-       $init->add(savepvn(sprintf("xpvlv_list[%d].xpv_pv",
-                                  $xpvlvsect->index), $pv));
-    }
-    $sv->save_magic;
-    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
-}
-
-sub B::PVIV::save {
-    my ($sv) = @_;
-    my $sym = objsym($sv);
-    return $sym if defined $sym;
-    my( $savesym, $pvmax, $len, $pv ) = save_pv_or_rv( $sv );
-    $xpvivsect->add(sprintf("%s, %u, %u, %d", $savesym, $len, $pvmax, $sv->IVX));
-    $svsect->add(sprintf("&xpviv_list[%d], %u, 0x%x",
-                        $xpvivsect->index, $sv->REFCNT , $sv->FLAGS));
-    if (defined($pv) && !$pv_copy_on_grow) {
-       $init->add(savepvn(sprintf("xpviv_list[%d].xpv_pv",
-                                  $xpvivsect->index), $pv));
-    }
-    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
-}
-
-sub B::PVNV::save {
-    my ($sv) = @_;
-    my $sym = objsym($sv);
-    return $sym if defined $sym;
-    my( $savesym, $pvmax, $len, $pv ) = save_pv_or_rv( $sv );
-    my $val= $sv->NVX;
-    $val .= '.00' if $val =~ /^-?\d+$/;
-    $xpvnvsect->add(sprintf("%s, %u, %u, %d, %s",
-                           $savesym, $len, $pvmax, $sv->IVX, $val));
-    $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
-                        $xpvnvsect->index, $sv->REFCNT , $sv->FLAGS));
-    if (defined($pv) && !$pv_copy_on_grow) {
-       $init->add(savepvn(sprintf("xpvnv_list[%d].xpv_pv",
-                                  $xpvnvsect->index), $pv));
-    }
-    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
-}
-
-sub B::BM::save {
-    my ($sv) = @_;
-    my $sym = objsym($sv);
-    return $sym if defined $sym;
-    my $pv = pack "a*", ($sv->PV . "\0" . $sv->TABLE);
-    my $len = length($pv);
-    $xpvbmsect->add(sprintf("0, %u, %u, %d, %s, 0, 0, %d, %u, 0x%x",
-                           $len, $len + 258, $sv->IVX, $sv->NVX,
-                           $sv->USEFUL, $sv->PREVIOUS, $sv->RARE));
-    $svsect->add(sprintf("&xpvbm_list[%d], %lu, 0x%x",
-                        $xpvbmsect->index, $sv->REFCNT , $sv->FLAGS));
-    $sv->save_magic;
-    $init->add(savepvn(sprintf("xpvbm_list[%d].xpv_pv",
-                              $xpvbmsect->index), $pv),
-              sprintf("xpvbm_list[%d].xpv_cur = %u;",
-                      $xpvbmsect->index, $len - 257));
-    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
-}
-
-sub B::PV::save {
-    my ($sv) = @_;
-    my $sym = objsym($sv);
-    return $sym if defined $sym;
-    my( $savesym, $pvmax, $len, $pv ) = save_pv_or_rv( $sv );
-    $xpvsect->add(sprintf("%s, %u, %u", $savesym, $len, $pvmax));
-    $svsect->add(sprintf("&xpv_list[%d], %lu, 0x%x",
-                        $xpvsect->index, $sv->REFCNT , $sv->FLAGS));
-    if (defined($pv) && !$pv_copy_on_grow) {
-       $init->add(savepvn(sprintf("xpv_list[%d].xpv_pv",
-                                  $xpvsect->index), $pv));
-    }
-    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
-}
-
-sub B::PVMG::save {
-    my ($sv) = @_;
-    my $sym = objsym($sv);
-    return $sym if defined $sym;
-    my( $savesym, $pvmax, $len, $pv ) = save_pv_or_rv( $sv );
-
-    $xpvmgsect->add(sprintf("%s, %u, %u, %d, %s, 0, 0",
-                            $savesym, $len, $pvmax,
-                            $sv->IVX, $sv->NVX));
-    $svsect->add(sprintf("&xpvmg_list[%d], %lu, 0x%x",
-                         $xpvmgsect->index, $sv->REFCNT , $sv->FLAGS));
-    if (defined($pv) && !$pv_copy_on_grow) {
-        $init->add(savepvn(sprintf("xpvmg_list[%d].xpv_pv",
-                                   $xpvmgsect->index), $pv));
-    }
-    $sym = savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
-    $sv->save_magic;
-    return $sym;
-}
-
-sub B::PVMG::save_magic {
-    my ($sv) = @_;
-    #warn sprintf("saving magic for %s (0x%x)\n", class($sv), $$sv); # debug
-    my $stash = $sv->SvSTASH;
-    $stash->save;
-    if ($$stash) {
-       warn sprintf("xmg_stash = %s (0x%x)\n", $stash->NAME, $$stash)
-           if $debug_mg;
-       # XXX Hope stash is already going to be saved.
-       $init->add(sprintf("SvSTASH(s\\_%x) = s\\_%x;", $$sv, $$stash));
-    }
-    my @mgchain = $sv->MAGIC;
-    my ($mg, $type, $obj, $ptr,$len,$ptrsv);
-    foreach $mg (@mgchain) {
-       $type = $mg->TYPE;
-       $ptr = $mg->PTR;
-       $len=$mg->LENGTH;
-       if ($debug_mg) {
-           warn sprintf("magic %s (0x%x), obj %s (0x%x), type %s, ptr %s\n",
-                        class($sv), $$sv, class($obj), $$obj,
-                        cchar($type), cstring($ptr));
-       }
-
-        unless( $type eq 'r' ) {
-          $obj = $mg->OBJ;
-          $obj->save;
-        }
-
-       if ($len == HEf_SVKEY){
-               #The pointer is an SV*
-               $ptrsv=svref_2object($ptr)->save;
-               $init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s,(char *) %s, %d);",
-                          $$sv, $$obj, cchar($type),$ptrsv,$len));
-        }elsif( $type eq 'r' ){
-            my $rx = $mg->REGEX;
-            my $pmop = $REGEXP{$rx};
-
-            confess "PMOP not found for REGEXP $rx" unless $pmop;
-
-            my( $resym, $relen ) = savere( $mg->precomp );
-            my $pmsym = $pmop->save;
-            $init->add( split /\n/, sprintf <<CODE, $$sv, cchar($type), cstring($ptr) );
-{
-    REGEXP* rx = pregcomp($resym, $resym + $relen, (PMOP*)$pmsym);
-    sv_magic((SV*)s\\_%x, (SV*)rx, %s, %s, %d);
-}
-CODE
-        }else{
-               $init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s, %s, %d);",
-                          $$sv, $$obj, cchar($type),cstring($ptr),$len));
-       }
-    }
-}
-
-sub B::RV::save {
-    my ($sv) = @_;
-    my $sym = objsym($sv);
-    return $sym if defined $sym;
-    my $rv = save_rv( $sv );
-    # GVs need to be handled at runtime
-    if( ref( $sv->RV ) eq 'B::GV' ) {
-        $xrvsect->add( "(SV*)Nullgv" );
-        $init->add(sprintf("xrv_list[%d].xrv_rv = (SV*)%s;\n", $xrvsect->index, $rv));
-    }
-    # and stashes, too
-    elsif( $sv->RV->isa( 'B::HV' ) && $sv->RV->NAME ) {
-        $xrvsect->add( "(SV*)Nullhv" );
-        $init->add(sprintf("xrv_list[%d].xrv_rv = (SV*)%s;\n", $xrvsect->index, $rv));
-    }
-    else {
-        $xrvsect->add($rv);
-    }
-    $svsect->add(sprintf("&xrv_list[%d], %lu, 0x%x",
-                        $xrvsect->index, $sv->REFCNT , $sv->FLAGS));
-    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
-}
-
-sub try_autoload {
-    my ($cvstashname, $cvname) = @_;
-    warn sprintf("No definition for sub %s::%s\n", $cvstashname, $cvname);
-    # Handle AutoLoader classes explicitly. Any more general AUTOLOAD
-    # use should be handled by the class itself.
-    no strict 'refs';
-    my $isa = \@{"$cvstashname\::ISA"};
-    if (grep($_ eq "AutoLoader", @$isa)) {
-       warn "Forcing immediate load of sub derived from AutoLoader\n";
-       # Tweaked version of AutoLoader::AUTOLOAD
-       my $dir = $cvstashname;
-       $dir =~ s(::)(/)g;
-       eval { require "auto/$dir/$cvname.al" };
-       if ($@) {
-           warn qq(failed require "auto/$dir/$cvname.al": $@\n);
-           return 0;
-       } else {
-           return 1;
-       }
-    }
-}
-sub Dummy_initxs{};
-sub B::CV::save {
-    my ($cv) = @_;
-    my $sym = objsym($cv);
-    if (defined($sym)) {
-#      warn sprintf("CV 0x%x already saved as $sym\n", $$cv); # debug
-       return $sym;
-    }
-    # Reserve a place in svsect and xpvcvsect and record indices
-    my $gv = $cv->GV;
-    my ($cvname, $cvstashname);
-    if ($$gv){
-       $cvname = $gv->NAME;
-       $cvstashname = $gv->STASH->NAME;
-    }
-    my $root = $cv->ROOT;
-    my $cvxsub = $cv->XSUB;
-    my $isconst = $cv->CvFLAGS & CVf_CONST;
-    if( $isconst ) {
-        my $value = $cv->XSUBANY;
-        my $stash = $gv->STASH;
-        my $vsym = $value->save;
-        my $stsym = $stash->save;
-        my $name = cstring($cvname);
-        $decl->add( "static CV* cv$cv_index;" );
-        $init->add( "cv$cv_index = newCONSTSUB( $stsym, NULL, $vsym );" );
-        my $sym = savesym( $cv, "cv$cv_index" );
-        $cv_index++;
-        return $sym;
-    }
-    #INIT is removed from the symbol table, so this call must come
-    # from PL_initav->save. Re-bootstrapping  will push INIT back in
-    # so nullop should be sent.
-    if (!$isconst && $cvxsub && ($cvname ne "INIT")) {
-       my $egv = $gv->EGV;
-       my $stashname = $egv->STASH->NAME;
-         if ($cvname eq "bootstrap")
-          { 
-           my $file = $gv->FILE;
-           $decl->add("/* bootstrap $file */"); 
-           warn "Bootstrap $stashname $file\n";
-           # if it not isa('DynaLoader'), it should hopefully be XSLoaded
-           # ( attributes being an exception, of course )
-           if( $stashname ne 'attributes' &&
-               !UNIVERSAL::isa($stashname,'DynaLoader') ) {
-            $xsub{$stashname}='Dynamic-XSLoaded';
-            $use_xsloader = 1;
-           }
-           else {
-            $xsub{$stashname}='Dynamic';
-           }
-          # $xsub{$stashname}='Static' unless  $xsub{$stashname};
-           return qq/NULL/;
-          }
-         else
-          {
-           # XSUBs for IO::File, IO::Handle, IO::Socket,
-           # IO::Seekable and IO::Poll
-           # are defined in IO.xs, so let's bootstrap it
-           svref_2object( \&IO::bootstrap )->save
-            if grep { $stashname eq $_ } qw(IO::File IO::Handle IO::Socket
-                                              IO::Seekable IO::Poll);
-          }
-        warn sprintf("stub for XSUB $cvstashname\:\:$cvname CV 0x%x\n", $$cv) if $debug_cv;
-       return qq/(perl_get_cv("$stashname\:\:$cvname",TRUE))/;
-    }
-    if ($cvxsub && $cvname eq "INIT") {
-        no strict 'refs';
-        return svref_2object(\&Dummy_initxs)->save;
-    }
-    my $sv_ix = $svsect->index + 1;
-    $svsect->add("svix$sv_ix");
-    my $xpvcv_ix = $xpvcvsect->index + 1;
-    $xpvcvsect->add("xpvcvix$xpvcv_ix");
-    # Save symbol now so that GvCV() doesn't recurse back to us via CvGV()
-    $sym = savesym($cv, "&sv_list[$sv_ix]");
-    warn sprintf("saving $cvstashname\:\:$cvname CV 0x%x as $sym\n", $$cv) if $debug_cv;
-    if (!$$root && !$cvxsub) {
-       if (try_autoload($cvstashname, $cvname)) {
-           # Recalculate root and xsub
-           $root = $cv->ROOT;
-           $cvxsub = $cv->XSUB;
-           if ($$root || $cvxsub) {
-               warn "Successful forced autoload\n";
-           }
-       }
-    }
-    my $startfield = 0;
-    my $padlist = $cv->PADLIST;
-    my $pv = $cv->PV;
-    my $xsub = 0;
-    my $xsubany = "Nullany";
-    if ($$root) {
-       warn sprintf("saving op tree for CV 0x%x, root = 0x%x\n",
-                    $$cv, $$root) if $debug_cv;
-       my $ppname = "";
-       if ($$gv) {
-           my $stashname = $gv->STASH->NAME;
-           my $gvname = $gv->NAME;
-           if ($gvname ne "__ANON__") {
-               $ppname = (${$gv->FORM} == $$cv) ? "pp_form_" : "pp_sub_";
-               $ppname .= ($stashname eq "main") ?
-                           $gvname : "$stashname\::$gvname";
-               $ppname =~ s/::/__/g;
-               if ($gvname eq "INIT"){
-                      $ppname .= "_$initsub_index";
-                      $initsub_index++;
-                   }
-           }
-       }
-       if (!$ppname) {
-           $ppname = "pp_anonsub_$anonsub_index";
-           $anonsub_index++;
-       }
-       $startfield = saveoptree($ppname, $root, $cv->START, $padlist->ARRAY);
-       warn sprintf("done saving op tree for CV 0x%x, name %s, root 0x%x\n",
-                    $$cv, $ppname, $$root) if $debug_cv;
-       if ($$padlist) {
-           warn sprintf("saving PADLIST 0x%x for CV 0x%x\n",
-                        $$padlist, $$cv) if $debug_cv;
-           $padlist->save;
-           warn sprintf("done saving PADLIST 0x%x for CV 0x%x\n",
-                        $$padlist, $$cv) if $debug_cv;
-       }
-    }
-    else {
-       warn sprintf("No definition for sub %s::%s (unable to autoload)\n",
-                    $cvstashname, $cvname); # debug
-    }              
-    $pv = '' unless defined $pv; # Avoid use of undef warnings
-    $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, \"\", %d, s\\_%x, (CV*)s\\_%x, 0x%x, 0x%x",
-                         $xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
-                         $cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH,
-                        $$padlist, ${$cv->OUTSIDE}, $cv->CvFLAGS,
-                       $cv->OUTSIDE_SEQ));
-
-    if (${$cv->OUTSIDE} == ${main_cv()}){
-       $init->add(sprintf("CvOUTSIDE(s\\_%x)=PL_main_cv;",$$cv));
-       $init->add(sprintf("SvREFCNT_inc(PL_main_cv);"));
-    }
-
-    if ($$gv) {
-       $gv->save;
-       $init->add(sprintf("CvGV(s\\_%x) = s\\_%x;",$$cv,$$gv));
-       warn sprintf("done saving GV 0x%x for CV 0x%x\n",
-                    $$gv, $$cv) if $debug_cv;
-    }
-    if( $ithreads ) {
-        $init->add( savepvn( "CvFILE($sym)", $cv->FILE) );
-    }
-    else {
-        $init->add(sprintf("CvFILE($sym) = %s;", cstring($cv->FILE)));
-    }
-    my $stash = $cv->STASH;
-    if ($$stash) {
-       $stash->save;
-       $init->add(sprintf("CvSTASH(s\\_%x) = s\\_%x;", $$cv, $$stash));
-       warn sprintf("done saving STASH 0x%x for CV 0x%x\n",
-                    $$stash, $$cv) if $debug_cv;
-    }
-    $symsect->add(sprintf("svix%d\t(XPVCV*)&xpvcv_list[%u], %lu, 0x%x",
-                         $sv_ix, $xpvcv_ix, $cv->REFCNT +1*0 , $cv->FLAGS));
-    return $sym;
-}
-
-sub B::GV::save {
-    my ($gv) = @_;
-    my $sym = objsym($gv);
-    if (defined($sym)) {
-       #warn sprintf("GV 0x%x already saved as $sym\n", $$gv); # debug
-       return $sym;
-    } else {
-       my $ix = $gv_index++;
-       $sym = savesym($gv, "gv_list[$ix]");
-       #warn sprintf("Saving GV 0x%x as $sym\n", $$gv); # debug
-    }
-    my $is_empty = $gv->is_empty;
-    my $gvname = $gv->NAME;
-    my $fullname = $gv->STASH->NAME . "::" . $gvname;
-    my $name = cstring($fullname);
-    #warn "GV name is $name\n"; # debug
-    my $egvsym;
-    unless ($is_empty) {
-       my $egv = $gv->EGV;
-       if ($$gv != $$egv) {
-           #warn(sprintf("EGV name is %s, saving it now\n",
-           #        $egv->STASH->NAME . "::" . $egv->NAME)); # debug
-           $egvsym = $egv->save;
-       }
-    }
-    $init->add(qq[$sym = gv_fetchpv($name, TRUE, SVt_PV);],
-              sprintf("SvFLAGS($sym) = 0x%x;", $gv->FLAGS ),
-              sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS));
-    $init->add(sprintf("GvLINE($sym) = %u;", $gv->LINE)) unless $is_empty;
-    # XXX hack for when Perl accesses PVX of GVs
-    $init->add("SvPVX($sym) = emptystring;\n");
-    # Shouldn't need to do save_magic since gv_fetchpv handles that
-    #$gv->save_magic;
-    # XXX will always be > 1!!!
-    my $refcnt = $gv->REFCNT + 1;
-    $init->add(sprintf("SvREFCNT($sym) += %u;", $refcnt - 1 )) if $refcnt > 1;
-
-    return $sym if $is_empty;
-
-    # XXX B::walksymtable creates an extra reference to the GV
-    my $gvrefcnt = $gv->GvREFCNT;
-    if ($gvrefcnt > 1) {
-       $init->add(sprintf("GvREFCNT($sym) += %u;", $gvrefcnt - 1));
-    }
-    # some non-alphavetic globs require some parts to be saved
-    # ( ex. %!, but not $! )
-    sub Save_HV() { 1 }
-    sub Save_AV() { 2 }
-    sub Save_SV() { 4 }
-    sub Save_CV() { 8 }
-    sub Save_FORM() { 16 }
-    sub Save_IO() { 32 }
-    my $savefields = 0;
-    if( $gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/ ) {
-        $savefields = Save_HV|Save_AV|Save_SV|Save_CV|Save_FORM|Save_IO;
-    }
-    elsif( $gvname eq '!' ) {
-        $savefields = Save_HV;
-    }
-    # attributes::bootstrap is created in perl_parse
-    # saving it would overwrite it, because perl_init() is
-    # called after perl_parse()
-    $savefields&=~Save_CV if $fullname eq 'attributes::bootstrap';
-
-    # save it
-    # XXX is that correct?
-    if (defined($egvsym) && $egvsym !~ m/Null/ ) {
-       # Shared glob *foo = *bar
-       $init->add("gp_free($sym);",
-                  "GvGP($sym) = GvGP($egvsym);");
-    } elsif ($savefields) {
-       # Don't save subfields of special GVs (*_, *1, *# and so on)
-#      warn "GV::save saving subfields\n"; # debug
-       my $gvsv = $gv->SV;
-       if ($$gvsv && $savefields&Save_SV) {
-           $gvsv->save;
-           $init->add(sprintf("GvSV($sym) = s\\_%x;", $$gvsv));
-#          warn "GV::save \$$name\n"; # debug
-       }
-       my $gvav = $gv->AV;
-       if ($$gvav && $savefields&Save_AV) {
-           $gvav->save;
-           $init->add(sprintf("GvAV($sym) = s\\_%x;", $$gvav));
-#          warn "GV::save \@$name\n"; # debug
-       }
-       my $gvhv = $gv->HV;
-       if ($$gvhv && $savefields&Save_HV) {
-           $gvhv->save;
-           $init->add(sprintf("GvHV($sym) = s\\_%x;", $$gvhv));
-#          warn "GV::save \%$name\n"; # debug
-       }
-       my $gvcv = $gv->CV;
-       if ($$gvcv && $savefields&Save_CV) {
-           my $origname=cstring($gvcv->GV->EGV->STASH->NAME .
-                "::" . $gvcv->GV->EGV->NAME);  
-           if (0 && $gvcv->XSUB && $name ne $origname) { #XSUB alias
-               # must save as a 'stub' so newXS() has a CV to populate
-                $init->add("{ CV *cv;");
-                $init->add("\tcv=perl_get_cv($origname,TRUE);");
-                $init->add("\tGvCV($sym)=cv;");
-                $init->add("\tSvREFCNT_inc((SV *)cv);");
-                $init->add("}");    
-           } else {
-               $init->add(sprintf("GvCV($sym) = (CV*)(%s);", $gvcv->save));
-#              warn "GV::save &$name\n"; # debug
-           } 
-        }     
-       $init->add(sprintf("GvFILE($sym) = %s;", cstring($gv->FILE)));
-#      warn "GV::save GvFILE(*$name)\n"; # debug
-       my $gvform = $gv->FORM;
-       if ($$gvform && $savefields&Save_FORM) {
-           $gvform->save;
-           $init->add(sprintf("GvFORM($sym) = (CV*)s\\_%x;", $$gvform));
-#          warn "GV::save GvFORM(*$name)\n"; # debug
-       }
-       my $gvio = $gv->IO;
-       if ($$gvio && $savefields&Save_IO) {
-           $gvio->save;
-           $init->add(sprintf("GvIOp($sym) = s\\_%x;", $$gvio));
-            if( $fullname =~ m/::DATA$/ && $save_data_fh ) {
-                no strict 'refs';
-                my $fh = *{$fullname}{IO};
-                use strict 'refs';
-                $gvio->save_data( $fullname, <$fh> ) if $fh->opened;
-            }
-#          warn "GV::save GvIO(*$name)\n"; # debug
-       }
-    }
-    return $sym;
-}
-
-sub B::AV::save {
-    my ($av) = @_;
-    my $sym = objsym($av);
-    return $sym if defined $sym;
-    my $line = "0, -1, -1, 0, 0.0, 0, Nullhv, 0, 0";
-    $line .= sprintf(", 0x%x", $av->AvFLAGS) if $] < 5.009;
-    $xpvavsect->add($line);
-    $svsect->add(sprintf("&xpvav_list[%d], %lu, 0x%x",
-                        $xpvavsect->index, $av->REFCNT  , $av->FLAGS));
-    my $sv_list_index = $svsect->index;
-    my $fill = $av->FILL;
-    $av->save_magic;
-    if ($debug_av) {
-       $line = sprintf("saving AV 0x%x FILL=$fill", $$av);
-       $line .= sprintf(" AvFLAGS=0x%x", $av->AvFLAGS) if $] < 5.009;
-       warn $line;
-    }
-    # XXX AVf_REAL is wrong test: need to save comppadlist but not stack
-    #if ($fill > -1 && ($avflags & AVf_REAL)) {
-    if ($fill > -1) {
-       my @array = $av->ARRAY;
-       if ($debug_av) {
-           my $el;
-           my $i = 0;
-           foreach $el (@array) {
-               warn sprintf("AV 0x%x[%d] = %s 0x%x\n",
-                            $$av, $i++, class($el), $$el);
-           }
-       }
-#      my @names = map($_->save, @array);
-       # XXX Better ways to write loop?
-       # Perhaps svp[0] = ...; svp[1] = ...; svp[2] = ...;
-       # Perhaps I32 i = 0; svp[i++] = ...; svp[i++] = ...; svp[i++] = ...;
-
-        # micro optimization: op/pat.t ( and other code probably )
-        # has very large pads ( 20k/30k elements ) passing them to
-        # ->add is a performance bottleneck: passing them as a
-        # single string cuts runtime from 6min20sec to 40sec
-
-        # you want to keep this out of the no_split/split
-        # map("\t*svp++ = (SV*)$_;", @names),
-        my $acc = '';
-        foreach my $i ( 0..$#array ) {
-              $acc .= "\t*svp++ = (SV*)" . $array[$i]->save . ";\n\t";
-        }
-        $acc .= "\n";
-
-        $init->no_split;
-       $init->add("{",
-                  "\tSV **svp;",
-                  "\tAV *av = (AV*)&sv_list[$sv_list_index];",
-                  "\tav_extend(av, $fill);",
-                  "\tsvp = AvARRAY(av);" );
-        $init->add($acc);
-       $init->add("\tAvFILLp(av) = $fill;",
-                  "}");
-        $init->split;
-        # we really added a lot of lines ( B::C::InitSection->add
-        # should really scan for \n, but that would slow
-        # it down
-        $init->inc_count( $#array );
-    } else {
-       my $max = $av->MAX;
-       $init->add("av_extend((AV*)&sv_list[$sv_list_index], $max);")
-           if $max > -1;
-    }
-    return savesym($av, "(AV*)&sv_list[$sv_list_index]");
-}
-
-sub B::HV::save {
-    my ($hv) = @_;
-    my $sym = objsym($hv);
-    return $sym if defined $sym;
-    my $name = $hv->NAME;
-    if ($name) {
-       # It's a stash
-
-       # A perl bug means HvPMROOT isn't altered when a PMOP is freed. Usually
-       # the only symptom is that sv_reset tries to reset the PMf_USED flag of
-       # a trashed op but we look at the trashed op_type and segfault.
-       #my $adpmroot = ${$hv->PMROOT};
-       my $adpmroot = 0;
-       $decl->add("static HV *hv$hv_index;");
-       # XXX Beware of weird package names containing double-quotes, \n, ...?
-       $init->add(qq[hv$hv_index = gv_stashpv("$name", TRUE);]);
-       if ($adpmroot) {
-           $init->add(sprintf("HvPMROOT(hv$hv_index) = (PMOP*)s\\_%x;",
-                              $adpmroot));
-       }
-       $sym = savesym($hv, "hv$hv_index");
-       $hv_index++;
-       return $sym;
-    }
-    # It's just an ordinary HV
-    $xpvhvsect->add(sprintf("0, 0, %d, 0, 0.0, 0, Nullhv, %d, 0, 0, 0",
-                           $hv->MAX, $hv->RITER));
-    $svsect->add(sprintf("&xpvhv_list[%d], %lu, 0x%x",
-                        $xpvhvsect->index, $hv->REFCNT  , $hv->FLAGS));
-    my $sv_list_index = $svsect->index;
-    my @contents = $hv->ARRAY;
-    if (@contents) {
-       my $i;
-       for ($i = 1; $i < @contents; $i += 2) {
-           $contents[$i] = $contents[$i]->save;
-       }
-        $init->no_split;
-       $init->add("{", "\tHV *hv = (HV*)&sv_list[$sv_list_index];");
-       while (@contents) {
-           my ($key, $value) = splice(@contents, 0, 2);
-           $init->add(sprintf("\thv_store(hv, %s, %u, %s, %s);",
-                              cstring($key),length(pack "a*",$key),
-                               $value, hash($key)));
-#          $init->add(sprintf("\thv_store(hv, %s, %u, %s, %s);",
-#                             cstring($key),length($key),$value, 0));
-       }
-       $init->add("}");
-        $init->split;
-    }
-    $hv->save_magic();
-    return savesym($hv, "(HV*)&sv_list[$sv_list_index]");
-}
-
-sub B::IO::save_data {
-    my( $io, $globname, @data ) = @_;
-    my $data = join '', @data;
-
-    # XXX using $DATA might clobber it!
-    my $sym = svref_2object( \\$data )->save;
-    $init->add( split /\n/, <<CODE );
-    {
-        GV* gv = (GV*)gv_fetchpv( "$globname", TRUE, SVt_PV );
-        SV* sv = $sym;
-        GvSV( gv ) = sv;
-    }
-CODE
-    # for PerlIO::scalar
-    $use_xsloader = 1;
-    $init->add_eval( sprintf 'open(%s, "<", $%s)', $globname, $globname );
-}
-
-sub B::IO::save {
-    my ($io) = @_;
-    my $sym = objsym($io);
-    return $sym if defined $sym;
-    my $pv = $io->PV;
-    $pv = '' unless defined $pv;
-    my $len = length($pv);
-    $xpviosect->add(sprintf("0, %u, %u, %d, %s, 0, 0, 0, 0, 0, %d, %d, %d, %d, %s, Nullgv, %s, Nullgv, %s, Nullgv, %d, %s, 0x%x",
-                           $len, $len+1, $io->IVX, $io->NVX, $io->LINES,
-                           $io->PAGE, $io->PAGE_LEN, $io->LINES_LEFT,
-                           cstring($io->TOP_NAME), cstring($io->FMT_NAME), 
-                           cstring($io->BOTTOM_NAME), $io->SUBPROCESS,
-                           cchar($io->IoTYPE), $io->IoFLAGS));
-    $svsect->add(sprintf("&xpvio_list[%d], %lu, 0x%x",
-                        $xpviosect->index, $io->REFCNT , $io->FLAGS));
-    $sym = savesym($io, sprintf("(IO*)&sv_list[%d]", $svsect->index));
-    # deal with $x = *STDIN/STDOUT/STDERR{IO}
-    my $perlio_func;
-    foreach ( qw(stdin stdout stderr) ) {
-        $io->IsSTD($_) and $perlio_func = $_;
-    }
-    if( $perlio_func ) {
-        $init->add( "IoIFP(${sym})=PerlIO_${perlio_func}();" );
-        $init->add( "IoOFP(${sym})=PerlIO_${perlio_func}();" );
-    }
-
-    my ($field, $fsym);
-    foreach $field (qw(TOP_GV FMT_GV BOTTOM_GV)) {
-       $fsym = $io->$field();
-       if ($$fsym) {
-           $init->add(sprintf("Io$field($sym) = (GV*)s\\_%x;", $$fsym));
-           $fsym->save;
-       }
-    }
-    $io->save_magic;
-    return $sym;
-}
-
-sub B::SV::save {
-    my $sv = shift;
-    # This is where we catch an honest-to-goodness Nullsv (which gets
-    # blessed into B::SV explicitly) and any stray erroneous SVs.
-    return 0 unless $$sv;
-    confess sprintf("cannot save that type of SV: %s (0x%x)\n",
-                   class($sv), $$sv);
-}
-
-sub output_all {
-    my $init_name = shift;
-    my $section;
-    my @sections = ($opsect, $unopsect, $binopsect, $logopsect, $condopsect,
-                   $listopsect, $pmopsect, $svopsect, $padopsect, $pvopsect,
-                   $loopsect, $copsect, $svsect, $xpvsect,
-                   $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect,
-                   $xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect);
-    $symsect->output(\*STDOUT, "#define %s\n");
-    print "\n";
-    output_declarations();
-    foreach $section (@sections) {
-       my $lines = $section->index + 1;
-       if ($lines) {
-           my $name = $section->name;
-           my $typename = ($name eq "xpvcv") ? "XPVCV_or_similar" : uc($name);
-           print "Static $typename ${name}_list[$lines];\n";
-       }
-    }
-    # XXX hack for when Perl accesses PVX of GVs
-    print 'Static char emptystring[] = "\0";';
-
-    $decl->output(\*STDOUT, "%s\n");
-    print "\n";
-    foreach $section (@sections) {
-       my $lines = $section->index + 1;
-       if ($lines) {
-           my $name = $section->name;
-           my $typename = ($name eq "xpvcv") ? "XPVCV_or_similar" : uc($name);
-           printf "static %s %s_list[%u] = {\n", $typename, $name, $lines;
-           $section->output(\*STDOUT, "\t{ %s }, /* %d */\n");
-           print "};\n\n";
-       }
-    }
-
-    $init->output(\*STDOUT, "\t%s\n", $init_name );
-    if ($verbose) {
-       warn compile_stats();
-       warn "NULLOP count: $nullop_count\n";
-    }
-}
-
-sub output_declarations {
-    print <<'EOT';
-#ifdef BROKEN_STATIC_REDECL
-#define Static extern
-#else
-#define Static static
-#endif /* BROKEN_STATIC_REDECL */
-
-#ifdef BROKEN_UNION_INIT
-#error BROKEN_UNION_INIT no longer needed, as Perl requires an ANSI compiler
-#endif
-
-#define XPVCV_or_similar XPVCV
-#define ANYINIT(i) {i}
-#define Nullany ANYINIT(0)
-
-#define UNUSED 0
-#define sym_0 0
-EOT
-    print "static GV *gv_list[$gv_index];\n" if $gv_index;
-    print "\n";
-}
-
-
-sub output_boilerplate {
-    print <<'EOT';
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-/* Workaround for mapstart: the only op which needs a different ppaddr */
-#undef Perl_pp_mapstart
-#define Perl_pp_mapstart Perl_pp_grepstart
-#undef OP_MAPSTART
-#define OP_MAPSTART OP_GREPSTART
-#define XS_DynaLoader_boot_DynaLoader boot_DynaLoader
-EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
-
-static void xs_init (pTHX);
-static void dl_init (pTHX);
-static PerlInterpreter *my_perl;
-EOT
-}
-
-sub init_op_addr {
-    my( $op_type, $num ) = @_;
-    my $op_list = $op_type."_list";
-
-    $init->add( split /\n/, <<EOT );
-    {
-        int i;
-
-        for( i = 0; i < ${num}; ++i )
-        {
-            ${op_list}\[i].op_ppaddr = PL_ppaddr[INT2PTR(int,${op_list}\[i].op_ppaddr)];
-        }
-    }
-EOT
-}
-
-sub init_op_warn {
-    my( $op_type, $num ) = @_;
-    my $op_list = $op_type."_list";
-
-    # for resons beyond imagination, MSVC5 considers pWARN_ALL non-const
-    $init->add( split /\n/, <<EOT );
-    {
-        int i;
-
-        for( i = 0; i < ${num}; ++i )
-        {
-            switch( (int)(${op_list}\[i].cop_warnings) )
-            {
-            case 1:
-                ${op_list}\[i].cop_warnings = pWARN_ALL;
-                break;
-            case 2:
-                ${op_list}\[i].cop_warnings = pWARN_NONE;
-                break;
-            case 3:
-                ${op_list}\[i].cop_warnings = pWARN_STD;
-                break;
-            default:
-                break;
-            }
-        }
-    }
-EOT
-}
-
-sub output_main {
-    print <<'EOT';
-/* if USE_IMPLICIT_SYS, we need a 'real' exit */
-#if defined(exit)
-#undef exit
-#endif
-
-int
-main(int argc, char **argv, char **env)
-{
-    int exitstatus;
-    int i;
-    char **fakeargv;
-    GV* tmpgv;
-    SV* tmpsv;
-    int options_count;
-
-    PERL_SYS_INIT3(&argc,&argv,&env);
-
-    if (!PL_do_undump) {
-       my_perl = perl_alloc();
-       if (!my_perl)
-           exit(1);
-       perl_construct( my_perl );
-       PL_perl_destruct_level = 0;
-    }
-EOT
-    if( $ithreads ) {
-        # XXX init free elems!
-        my $pad_len = regex_padav->FILL + 1 - 1; # first is an avref
-
-        print <<EOT;
-#ifdef USE_ITHREADS
-    for( i = 0; i < $pad_len; ++i ) {
-        av_push( PL_regex_padav, newSViv(0) );
-    }
-    PL_regex_pad = AvARRAY( PL_regex_padav );
-#endif
-EOT
-    }
-
-    print <<'EOT';
-#ifdef CSH
-    if (!PL_cshlen) 
-      PL_cshlen = strlen(PL_cshname);
-#endif
-
-#ifdef ALLOW_PERL_OPTIONS
-#define EXTRA_OPTIONS 3
-#else
-#define EXTRA_OPTIONS 4
-#endif /* ALLOW_PERL_OPTIONS */
-    Newx(fakeargv, argc + EXTRA_OPTIONS + 1, char *);
-
-    fakeargv[0] = argv[0];
-    fakeargv[1] = "-e";
-    fakeargv[2] = "";
-    options_count = 3;
-EOT
-    # honour -T
-    print <<EOT;
-    if( ${^TAINT} ) {
-        fakeargv[options_count] = "-T";
-        ++options_count;
-    }
-EOT
-    print <<'EOT';
-#ifndef ALLOW_PERL_OPTIONS
-    fakeargv[options_count] = "--";
-    ++options_count;
-#endif /* ALLOW_PERL_OPTIONS */
-    for (i = 1; i < argc; i++)
-       fakeargv[i + options_count - 1] = argv[i];
-    fakeargv[argc + options_count - 1] = 0;
-
-    exitstatus = perl_parse(my_perl, xs_init, argc + options_count - 1,
-                           fakeargv, NULL);
-
-    if (exitstatus)
-       exit( exitstatus );
-
-    TAINT;
-EOT
-
-    if( $use_perl_script_name ) {
-        my $dollar_0 = $0;
-        $dollar_0 =~ s/\\/\\\\/g;
-        $dollar_0 = '"' . $dollar_0 . '"';
-
-        print <<EOT;
-    if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) {/* $0 */
-        tmpsv = GvSV(tmpgv);
-        sv_setpv(tmpsv, ${dollar_0});
-        SvSETMAGIC(tmpsv);
-    }
-EOT
-    }
-    else {
-       print <<EOT;
-    if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) {/* $0 */
-        tmpsv = GvSV(tmpgv);
-        sv_setpv(tmpsv, argv[0]);
-        SvSETMAGIC(tmpsv);
-    }
-EOT
-    }
-
-    print <<'EOT';
-    if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))) {/* $^X */
-        tmpsv = GvSV(tmpgv);
-#ifdef WIN32
-        sv_setpv(tmpsv,"perl.exe");
-#else
-        sv_setpv(tmpsv,"perl");
-#endif
-        SvSETMAGIC(tmpsv);
-    }
-
-    TAINT_NOT;
-
-    /* PL_main_cv = PL_compcv; */
-    PL_compcv = 0;
-
-    exitstatus = perl_init();
-    if (exitstatus)
-       exit( exitstatus );
-    dl_init(aTHX);
-
-    exitstatus = perl_run( my_perl );
-
-    perl_destruct( my_perl );
-    perl_free( my_perl );
-
-    PERL_SYS_TERM();
-
-    exit( exitstatus );
-}
-
-/* yanked from perl.c */
-static void
-xs_init(pTHX)
-{
-    char *file = __FILE__;
-    dTARG;
-    dSP;
-EOT
-    print "\n#ifdef USE_DYNAMIC_LOADING";
-    print qq/\n\tnewXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);/;
-    print "\n#endif\n" ;
-    # delete $xsub{'DynaLoader'}; 
-    delete $xsub{'UNIVERSAL'}; 
-    print("/* bootstrapping code*/\n\tSAVETMPS;\n");
-    print("\ttarg=sv_newmortal();\n");
-    print "#ifdef USE_DYNAMIC_LOADING\n";
-    print "\tPUSHMARK(sp);\n";
-    print qq/\tXPUSHp("DynaLoader",strlen("DynaLoader"));\n/;
-    print qq/\tPUTBACK;\n/;
-    print "\tboot_DynaLoader(aTHX_ NULL);\n";
-    print qq/\tSPAGAIN;\n/;
-    print "#endif\n";
-    foreach my $stashname (keys %xsub){
-       if ($xsub{$stashname} !~ m/Dynamic/ ) {
-          my $stashxsub=$stashname;
-          $stashxsub  =~ s/::/__/g; 
-          print "\tPUSHMARK(sp);\n";
-          print qq/\tXPUSHp("$stashname",strlen("$stashname"));\n/;
-          print qq/\tPUTBACK;\n/;
-          print "\tboot_$stashxsub(aTHX_ NULL);\n";
-          print qq/\tSPAGAIN;\n/;
-       }   
-    }
-    print("\tFREETMPS;\n/* end bootstrapping code */\n");
-    print "}\n";
-    
-print <<'EOT';
-static void
-dl_init(pTHX)
-{
-    char *file = __FILE__;
-    dTARG;
-    dSP;
-EOT
-    print("/* Dynamicboot strapping code*/\n\tSAVETMPS;\n");
-    print("\ttarg=sv_newmortal();\n");
-    foreach my $stashname (@DynaLoader::dl_modules) {
-       warn "Loaded $stashname\n";
-       if (exists($xsub{$stashname}) && $xsub{$stashname} =~ m/Dynamic/) {
-          my $stashxsub=$stashname;
-          $stashxsub  =~ s/::/__/g; 
-          print "\tPUSHMARK(sp);\n";
-          print qq/\tXPUSHp("$stashname",/,length($stashname),qq/);\n/;
-          print qq/\tPUTBACK;\n/;
-           print "#ifdef USE_DYNAMIC_LOADING\n";
-          warn "bootstrapping $stashname added to xs_init\n";
-           if( $xsub{$stashname} eq 'Dynamic' ) {
-              print qq/\tperl_call_method("bootstrap",G_DISCARD);\n/;
-           }
-           else {
-              print qq/\tperl_call_pv("XSLoader::load",G_DISCARD);\n/;
-           }
-           print "#else\n";
-          print "\tboot_$stashxsub(aTHX_ NULL);\n";
-           print "#endif\n";
-          print qq/\tSPAGAIN;\n/;
-       }   
-    }
-    print("\tFREETMPS;\n/* end Dynamic bootstrapping code */\n");
-    print "}\n";
-}
-sub dump_symtable {
-    # For debugging
-    my ($sym, $val);
-    warn "----Symbol table:\n";
-    while (($sym, $val) = each %symtable) {
-       warn "$sym => $val\n";
-    }
-    warn "---End of symbol table\n";
-}
-
-sub save_object {
-    my $sv;
-    foreach $sv (@_) {
-       svref_2object($sv)->save;
-    }
-}       
-
-sub Dummy_BootStrap { }            
-
-sub B::GV::savecv 
-{
- my $gv = shift;
- my $package=$gv->STASH->NAME;
- my $name = $gv->NAME;
- my $cv = $gv->CV;
- my $sv = $gv->SV;
- my $av = $gv->AV;
- my $hv = $gv->HV;
-
- my $fullname = $gv->STASH->NAME . "::" . $gv->NAME;
-
- # We may be looking at this package just because it is a branch in the 
- # symbol table which is on the path to a package which we need to save
- # e.g. this is 'Getopt' and we need to save 'Getopt::Long'
- # 
- return unless ($unused_sub_packages{$package});
- return unless ($$cv || $$av || $$sv || $$hv);
- $gv->save;
-}
-
-sub mark_package
-{    
- my $package = shift;
- unless ($unused_sub_packages{$package})
-  {    
-   no strict 'refs';
-   $unused_sub_packages{$package} = 1;
-   if (defined @{$package.'::ISA'})
-    {
-     foreach my $isa (@{$package.'::ISA'}) 
-      {
-       if ($isa eq 'DynaLoader')
-        {
-         unless (defined(&{$package.'::bootstrap'}))
-          {                    
-           warn "Forcing bootstrap of $package\n";
-           eval { $package->bootstrap }; 
-          }
-        }
-#      else
-        {
-         unless ($unused_sub_packages{$isa})
-          {
-           warn "$isa saved (it is in $package\'s \@ISA)\n";
-           mark_package($isa);
-          }
-        }
-      }
-    }
-  }
- return 1;
-}
-     
-sub should_save
-{
- no strict qw(vars refs);
- my $package = shift;
- $package =~ s/::$//;
- return $unused_sub_packages{$package} = 0 if ($package =~ /::::/);  # skip ::::ISA::CACHE etc.
- # warn "Considering $package\n";#debug
- foreach my $u (grep($unused_sub_packages{$_},keys %unused_sub_packages)) 
-  {  
-   # If this package is a prefix to something we are saving, traverse it 
-   # but do not mark it for saving if it is not already
-   # e.g. to get to Getopt::Long we need to traverse Getopt but need
-   # not save Getopt
-   return 1 if ($u =~ /^$package\:\:/);
-  }
- if (exists $unused_sub_packages{$package})
-  {
-   # warn "Cached $package is ".$unused_sub_packages{$package}."\n"; 
-   delete_unsaved_hashINC($package) unless  $unused_sub_packages{$package} ;
-   return $unused_sub_packages{$package}; 
-  }
- # Omit the packages which we use (and which cause grief
- # because of fancy "goto &$AUTOLOAD" stuff).
- # XXX Surely there must be a nicer way to do this.
- if ($package eq "FileHandle" || $package eq "Config" || 
-     $package eq "SelectSaver" || $package =~/^(B|IO)::/) 
-  {
-   delete_unsaved_hashINC($package);
-   return $unused_sub_packages{$package} = 0;
-  }
- # Now see if current package looks like an OO class this is probably too strong.
- foreach my $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH TIEHANDLE)) 
-  {
-   if (UNIVERSAL::can($package, $m))
-    {
-     warn "$package has method $m: saving package\n";#debug
-     return mark_package($package);
-    }
-  }
- delete_unsaved_hashINC($package);
- return $unused_sub_packages{$package} = 0;
-}
-sub delete_unsaved_hashINC{
-       my $packname=shift;
-       $packname =~ s/\:\:/\//g;
-       $packname .= '.pm';
-#      warn "deleting $packname" if $INC{$packname} ;# debug
-       delete $INC{$packname};
-}
-sub walkpackages 
-{
- my ($symref, $recurse, $prefix) = @_;
- my $sym;
- my $ref;
- no strict 'vars';
- $prefix = '' unless defined $prefix;
- while (($sym, $ref) = each %$symref) 
-  {             
-   local(*glob);
-   *glob = $ref;
-   if ($sym =~ /::$/) 
-    {
-     $sym = $prefix . $sym;
-     if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) 
-      {
-       walkpackages(\%glob, $recurse, $sym);
-      }
-    } 
-  }
-}
-
-
-sub save_unused_subs 
-{
- no strict qw(refs);
- &descend_marked_unused;
- warn "Prescan\n";
- walkpackages(\%{"main::"}, sub { should_save($_[0]); return 1 });
- warn "Saving methods\n";
- walksymtable(\%{"main::"}, "savecv", \&should_save);
-}
-
-sub save_context
-{
- my $curpad_nam = (comppadlist->ARRAY)[0]->save;
- my $curpad_sym = (comppadlist->ARRAY)[1]->save;
- my $inc_hv     = svref_2object(\%INC)->save;
- my $inc_av     = svref_2object(\@INC)->save;
- my $amagic_generate= amagic_generation;          
- $init->add(   "PL_curpad = AvARRAY($curpad_sym);",
-              "GvHV(PL_incgv) = $inc_hv;",
-              "GvAV(PL_incgv) = $inc_av;",
-               "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
-               "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));",
-               "PL_amagic_generation= $amagic_generate;" );
-}
-
-sub descend_marked_unused {
-    foreach my $pack (keys %unused_sub_packages)
-    {
-       mark_package($pack);
-    }
-}
-sub save_main {
-    # this is mainly for the test suite
-    my $warner = $SIG{__WARN__};
-    local $SIG{__WARN__} = sub { print STDERR @_ };
-
-    warn "Starting compile\n";
-    warn "Walking tree\n";
-    seek(STDOUT,0,0); #exclude print statements in BEGIN{} into output
-    walkoptree(main_root, "save");
-    warn "done main optree, walking symtable for extras\n" if $debug_cv;
-    save_unused_subs();
-    # XSLoader was used, force saving of XSLoader::load
-    if( $use_xsloader ) {
-        my $cv = svref_2object( \&XSLoader::load );
-        $cv->save;
-    }
-    # save %SIG ( in case it was set in a BEGIN block )
-    if( $save_sig ) {
-        local $SIG{__WARN__} = $warner;
-        $init->no_split;
-        $init->add("{", "\tHV* hv = get_hv(\"main::SIG\",1);" );
-        foreach my $k ( keys %SIG ) {
-            next unless ref $SIG{$k};
-            my $cv = svref_2object( \$SIG{$k} );
-            my $sv = $cv->save;
-            $init->add('{',sprintf 'SV* sv = (SV*)%s;', $sv );
-            $init->add(sprintf("\thv_store(hv, %s, %u, %s, %s);",
-                               cstring($k),length(pack "a*",$k),
-                               'sv', hash($k)));
-            $init->add('mg_set(sv);','}');
-        }
-        $init->add('}');
-        $init->split;
-    }
-    # honour -w
-    $init->add( sprintf "    PL_dowarn = ( %s ) ? G_WARN_ON : G_WARN_OFF;", $^W );
-    #
-    my $init_av = init_av->save;
-    my $end_av = end_av->save;
-    $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
-              sprintf("PL_main_start = s\\_%x;", ${main_start()}),
-              "PL_initav = (AV *) $init_av;",
-              "PL_endav = (AV*) $end_av;");
-    save_context();
-    # init op addrs ( must be the last action, otherwise
-    # some ops might not be initialized
-    if( $optimize_ppaddr ) {
-        foreach my $i ( @op_sections ) {
-            my $section = $$i;
-            next unless $section->index >= 0;
-            init_op_addr( $section->name, $section->index + 1);
-        }
-    }
-    init_op_warn( $copsect->name, $copsect->index + 1)
-      if $optimize_warn_sv && $copsect->index >= 0;
-
-    warn "Writing output\n";
-    output_boilerplate();
-    print "\n";
-    output_all("perl_init");
-    print "\n";
-    output_main();
-}
-
-sub init_sections {
-    my @sections = (decl => \$decl, sym => \$symsect,
-                   binop => \$binopsect, condop => \$condopsect,
-                   cop => \$copsect, padop => \$padopsect,
-                   listop => \$listopsect, logop => \$logopsect,
-                   loop => \$loopsect, op => \$opsect, pmop => \$pmopsect,
-                   pvop => \$pvopsect, svop => \$svopsect, unop => \$unopsect,
-                   sv => \$svsect, xpv => \$xpvsect, xpvav => \$xpvavsect,
-                   xpvhv => \$xpvhvsect, xpvcv => \$xpvcvsect,
-                   xpviv => \$xpvivsect, xpvnv => \$xpvnvsect,
-                   xpvmg => \$xpvmgsect, xpvlv => \$xpvlvsect,
-                   xrv => \$xrvsect, xpvbm => \$xpvbmsect,
-                   xpvio => \$xpviosect);
-    my ($name, $sectref);
-    while (($name, $sectref) = splice(@sections, 0, 2)) {
-       $$sectref = new B::C::Section $name, \%symtable, 0;
-    }
-    $init = new B::C::InitSection 'init', \%symtable, 0;
-}
-
-sub mark_unused
-{
- my ($arg,$val) = @_;
- $unused_sub_packages{$arg} = $val;
-}
-
-sub compile {
-    my @options = @_;
-    my ($option, $opt, $arg);
-    my @eval_at_startup;
-    my %option_map = ( 'cog' => \$pv_copy_on_grow,
-                       'save-data' => \$save_data_fh,
-                       'ppaddr' => \$optimize_ppaddr,
-                       'warn-sv' => \$optimize_warn_sv,
-                       'use-script-name' => \$use_perl_script_name,
-                       'save-sig-hash' => \$save_sig,
-                     );
-    my %optimization_map = ( 0 => [ qw() ], # special case
-                             1 => [ qw(-fcog) ],
-                             2 => [ qw(-fwarn-sv -fppaddr) ],
-                           );
-  OPTION:
-    while ($option = shift @options) {
-       if ($option =~ /^-(.)(.*)/) {
-           $opt = $1;
-           $arg = $2;
-       } else {
-           unshift @options, $option;
-           last OPTION;
-       }
-       if ($opt eq "-" && $arg eq "-") {
-           shift @options;
-           last OPTION;
-       }
-       if ($opt eq "w") {
-           $warn_undefined_syms = 1;
-       } elsif ($opt eq "D") {
-           $arg ||= shift @options;
-           foreach $arg (split(//, $arg)) {
-               if ($arg eq "o") {
-                   B->debug(1);
-               } elsif ($arg eq "c") {
-                   $debug_cops = 1;
-               } elsif ($arg eq "A") {
-                   $debug_av = 1;
-               } elsif ($arg eq "C") {
-                   $debug_cv = 1;
-               } elsif ($arg eq "M") {
-                   $debug_mg = 1;
-               } else {
-                   warn "ignoring unknown debug option: $arg\n";
-               }
-           }
-       } elsif ($opt eq "o") {
-           $arg ||= shift @options;
-           open(STDOUT, ">$arg") or return "$arg: $!\n";
-       } elsif ($opt eq "v") {
-           $verbose = 1;
-       } elsif ($opt eq "u") {
-           $arg ||= shift @options;
-           mark_unused($arg,undef);
-       } elsif ($opt eq "f") {
-           $arg ||= shift @options;
-            $arg =~ m/(no-)?(.*)/;
-            my $no = defined($1) && $1 eq 'no-';
-            $arg = $no ? $2 : $arg;
-            if( exists $option_map{$arg} ) {
-                ${$option_map{$arg}} = !$no;
-            } else {
-                die "Invalid optimization '$arg'";
-            }
-       } elsif ($opt eq "O") {
-           $arg = 1 if $arg eq "";
-            my @opt;
-            foreach my $i ( 1 .. $arg ) {
-                push @opt, @{$optimization_map{$i}}
-                    if exists $optimization_map{$i};
-            }
-            unshift @options, @opt;
-        } elsif ($opt eq "e") {
-            push @eval_at_startup, $arg;
-       } elsif ($opt eq "l") {
-           $max_string_len = $arg;
-       }
-    }
-    init_sections();
-    foreach my $i ( @eval_at_startup ) {
-        $init->add_eval( $i );
-    }
-    if (@options) {
-       return sub {
-           my $objname;
-           foreach $objname (@options) {
-               eval "save_object(\\$objname)";
-           }
-           output_all();
-       }
-    } else {
-       return sub { save_main() };
-    }
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-B::C - Perl compiler's C backend
-
-=head1 SYNOPSIS
-
-       perl -MO=C[,OPTIONS] foo.pl
-
-=head1 DESCRIPTION
-
-This compiler backend takes Perl source and generates C source code
-corresponding to the internal structures that perl uses to run
-your program. When the generated C source is compiled and run, it
-cuts out 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 be
-either a help or a hindrance.
-
-=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<-v>
-
-Verbose compilation (currently gives a few compilation statistics).
-
-=item B<-->
-
-Force end of options
-
-=item B<-uPackname>
-
-Force apparently unused subs from package Packname to be compiled.
-This allows programs to use eval "foo()" even when sub foo is never
-seen to be used at compile time. The down side is that any subs which
-really are never used also have code generated. This option is
-necessary, for example, if you have a signal handler foo which you
-initialise with C<$SIG{BAR} = "foo">.  A better fix, though, is just
-to change it to C<$SIG{BAR} = \&foo>. You can have multiple B<-u>
-options. The compiler tries to figure out which packages may possibly
-have subs in which need compiling but the current version doesn't do
-it very well. In particular, it is confused by nested packages (i.e.
-of the form C<A::B>) where package C<A> does not contain any subs.
-
-=item B<-D>
-
-Debug options (concatenated or separate flags like C<perl -D>).
-
-=item B<-Do>
-
-OPs, prints each OP as it's processed
-
-=item B<-Dc>
-
-COPs, prints COPs as processed (incl. file & line num)
-
-=item B<-DA>
-
-prints AV information on saving
-
-=item B<-DC>
-
-prints CV information on saving
-
-=item B<-DM>
-
-prints MAGIC information on saving
-
-=item B<-f>
-
-Force options/optimisations on or off one at a time. You can explicitly
-disable an option using B<-fno-option>. All options default to
-B<disabled>.
-
-=over 4
-
-=item B<-fcog>
-
-Copy-on-grow: PVs declared and initialised statically.
-
-=item B<-fsave-data>
-
-Save package::DATA filehandles ( only available with PerlIO ).
-
-=item B<-fppaddr>
-
-Optimize the initialization of op_ppaddr.
-
-=item B<-fwarn-sv>
-
-Optimize the initialization of cop_warnings.
-
-=item B<-fuse-script-name>
-
-Use the script name instead of the program name as $0.
-
-=item B<-fsave-sig-hash>
-
-Save compile-time modifications to the %SIG hash.
-
-=back
-
-=item B<-On>
-
-Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
-
-=over 4
-
-=item B<-O0>
-
-Disable all optimizations.
-
-=item B<-O1>
-
-Enable B<-fcog>.
-
-=item B<-O2>
-
-Enable B<-fppaddr>, B<-fwarn-sv>.
-
-=back
-
-=item B<-llimit>
-
-Some C compilers impose an arbitrary limit on the length of string
-constants (e.g. 2048 characters for Microsoft Visual C++).  The
-B<-llimit> options tells the C backend not to generate string literals
-exceeding that limit.
-
-=back
-
-=head1 EXAMPLES
-
-    perl -MO=C,-ofoo.c foo.pl
-    perl cc_harness -o foo foo.c
-
-Note that C<cc_harness> lives in the C<B> subdirectory of your perl
-library directory. The utility called C<perlcc> may also be used to
-help make use of this compiler.
-
-    perl -MO=C,-v,-DcA,-l2048 bar.pl > /dev/null
-
-=head1 BUGS
-
-Plenty. Current status: experimental.
-
-=head1 AUTHOR
-
-Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
-
-=cut
diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
deleted file mode 100644 (file)
index 43064fb..0000000
+++ /dev/null
@@ -1,2005 +0,0 @@
-#      CC.pm
-#
-#      Copyright (c) 1996, 1997, 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::CC;
-
-our $VERSION = '1.00';
-
-use Config;
-use strict;
-use B qw(main_start main_root class comppadlist peekop svref_2object
-       timing_info init_av sv_undef amagic_generation 
-       OPf_WANT_LIST OPf_WANT OPf_MOD OPf_STACKED OPf_SPECIAL
-       OPpASSIGN_BACKWARDS OPpLVAL_INTRO OPpDEREF_AV OPpDEREF_HV
-       OPpDEREF OPpFLIP_LINENUM G_ARRAY G_SCALAR    
-       CXt_NULL CXt_SUB CXt_EVAL CXt_LOOP CXt_SUBST CXt_BLOCK
-       );
-use B::C qw(save_unused_subs objsym init_sections mark_unused
-           output_all output_boilerplate output_main);
-use B::Bblock qw(find_leaders);
-use B::Stackobj qw(:types :flags);
-
-# These should probably be elsewhere
-# Flags for $op->flags
-
-my $module;            # module name (when compiled with -m)
-my %done;              # hash keyed by $$op of leaders of basic blocks
-                       # which have already been done.
-my $leaders;           # ref to hash of basic block leaders. Keys are $$op
-                       # addresses, values are the $op objects themselves.
-my @bblock_todo;       # list of leaders of basic blocks that need visiting
-                       # sometime.
-my @cc_todo;           # list of tuples defining what PP code needs to be
-                       # saved (e.g. CV, main or PMOP repl code). Each tuple
-                       # is [$name, $root, $start, @padlist]. PMOP repl code
-                       # tuples inherit padlist.
-my @stack;             # shadows perl's stack when contents are known.
-                       # Values are objects derived from class B::Stackobj
-my @pad;               # Lexicals in current pad as Stackobj-derived objects
-my @padlist;           # Copy of current padlist so PMOP repl code can find it
-my @cxstack;           # Shadows the (compile-time) cxstack for next,last,redo
-my $jmpbuf_ix = 0;     # Next free index for dynamically allocated jmpbufs
-my %constobj;          # OP_CONST constants as Stackobj-derived objects
-                       # keyed by $$sv.
-my $need_freetmps = 0; # We may postpone FREETMPS to the end of each basic
-                       # block or even to the end of each loop of blocks,
-                       # depending on optimisation options.
-my $know_op = 0;       # Set when C variable op already holds the right op
-                       # (from an immediately preceding DOOP(ppname)).
-my $errors = 0;                # Number of errors encountered
-my %skip_stack;                # Hash of PP names which don't need write_back_stack
-my %skip_lexicals;     # Hash of PP names which don't need write_back_lexicals
-my %skip_invalidate;   # Hash of PP names which don't need invalidate_lexicals
-my %ignore_op;         # Hash of ops which do nothing except returning op_next
-my %need_curcop;       # Hash of ops which need PL_curcop
-
-my %lexstate;          #state of padsvs at the start of a bblock
-
-BEGIN {
-    foreach (qw(pp_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) {
-       $ignore_op{$_} = 1;
-    }
-}
-
-my ($module_name);
-my ($debug_op, $debug_stack, $debug_cxstack, $debug_pad, $debug_runtime,
-    $debug_shadow, $debug_queue, $debug_lineno, $debug_timings);
-
-# 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.
-my ($freetmps_each_bblock, $freetmps_each_loop, $omit_taint);
-my %optimise = (freetmps_each_bblock   => \$freetmps_each_bblock,
-               freetmps_each_loop      => \$freetmps_each_loop,
-               omit_taint              => \$omit_taint);
-# perl patchlevel to generate code for (defaults to current patchlevel)
-my $patchlevel = int(0.5 + 1000 * ($]  - 5));
-
-# Could rewrite push_runtime() and output_runtime() to use a
-# temporary file if memory is at a premium.
-my $ppname;            # name of current fake PP function
-my $runtime_list_ref;
-my $declare_ref;       # Hash ref keyed by C variable type of declarations.
-
-my @pp_list;           # list of [$ppname, $runtime_list_ref, $declare_ref]
-                       # tuples to be written out.
-
-my ($init, $decl);
-
-sub init_hash { map { $_ => 1 } @_ }
-
-#
-# Initialise the hashes for the default PP functions where we can avoid
-# either write_back_stack, write_back_lexicals or invalidate_lexicals.
-#
-%skip_lexicals = init_hash qw(pp_enter pp_enterloop);
-%skip_invalidate = init_hash qw(pp_enter pp_enterloop);
-%need_curcop = init_hash qw(pp_rv2gv  pp_bless pp_repeat pp_sort pp_caller
-                       pp_reset pp_rv2cv pp_entereval pp_require pp_dofile
-                       pp_entertry pp_enterloop pp_enteriter pp_entersub
-                       pp_enter pp_method);
-
-sub debug {
-    if ($debug_runtime) {
-       warn(@_);
-    } else {
-       my @tmp=@_;
-       runtime(map { chomp; "/* $_ */"} @tmp);
-    }
-}
-
-sub declare {
-    my ($type, $var) = @_;
-    push(@{$declare_ref->{$type}}, $var);
-}
-
-sub push_runtime {
-    push(@$runtime_list_ref, @_);
-    warn join("\n", @_) . "\n" if $debug_runtime;
-}
-
-sub save_runtime {
-    push(@pp_list, [$ppname, $runtime_list_ref, $declare_ref]);
-}
-
-sub output_runtime {
-    my $ppdata;
-    print qq(#include "cc_runtime.h"\n);
-    foreach $ppdata (@pp_list) {
-       my ($name, $runtime, $declare) = @$ppdata;
-       print "\nstatic\nCCPP($name)\n{\n";
-       my ($type, $varlist, $line);
-       while (($type, $varlist) = each %$declare) {
-           print "\t$type ", join(", ", @$varlist), ";\n";
-       }
-       foreach $line (@$runtime) {
-           print $line, "\n";
-       }
-       print "}\n";
-    }
-}
-
-sub runtime {
-    my $line;
-    foreach $line (@_) {
-       push_runtime("\t$line");
-    }
-}
-
-sub init_pp {
-    $ppname = shift;
-    $runtime_list_ref = [];
-    $declare_ref = {};
-    runtime("dSP;");
-    declare("I32", "oldsave");
-    declare("SV", "**svp");
-    map { declare("SV", "*$_") } qw(sv src dst left right);
-    declare("MAGIC", "*mg");
-    $decl->add("static OP * $ppname (pTHX);");
-    debug "init_pp: $ppname\n" if $debug_queue;
-}
-
-# Initialise runtime_callback function for Stackobj class
-BEGIN { B::Stackobj::set_callback(\&runtime) }
-
-# Initialise saveoptree_callback for B::C class
-sub cc_queue {
-    my ($name, $root, $start, @pl) = @_;
-    debug "cc_queue: name $name, root $root, start $start, padlist (@pl)\n"
-       if $debug_queue;
-    if ($name eq "*ignore*") {
-       $name = 0;
-    } else {
-       push(@cc_todo, [$name, $root, $start, (@pl ? @pl : @padlist)]);
-    }
-    my $fakeop = new B::FAKEOP ("next" => 0, sibling => 0, ppaddr => $name);
-    $start = $fakeop->save;
-    debug "cc_queue: name $name returns $start\n" if $debug_queue;
-    return $start;
-}
-BEGIN { B::C::set_callback(\&cc_queue) }
-
-sub valid_int { $_[0]->{flags} & VALID_INT }
-sub valid_double { $_[0]->{flags} & VALID_DOUBLE }
-sub valid_numeric { $_[0]->{flags} & (VALID_INT | VALID_DOUBLE) }
-sub valid_sv { $_[0]->{flags} & VALID_SV }
-
-sub top_int { @stack ? $stack[-1]->as_int : "TOPi" }
-sub top_double { @stack ? $stack[-1]->as_double : "TOPn" }
-sub top_numeric { @stack ? $stack[-1]->as_numeric : "TOPn" }
-sub top_sv { @stack ? $stack[-1]->as_sv : "TOPs" }
-sub top_bool { @stack ? $stack[-1]->as_bool : "SvTRUE(TOPs)" }
-
-sub pop_int { @stack ? (pop @stack)->as_int : "POPi" }
-sub pop_double { @stack ? (pop @stack)->as_double : "POPn" }
-sub pop_numeric { @stack ? (pop @stack)->as_numeric : "POPn" }
-sub pop_sv { @stack ? (pop @stack)->as_sv : "POPs" }
-sub pop_bool {
-    if (@stack) {
-       return ((pop @stack)->as_bool);
-    } else {
-       # Careful: POPs has an auto-decrement and SvTRUE evaluates
-       # its argument more than once.
-       runtime("sv = POPs;");
-       return "SvTRUE(sv)";
-    }
-}
-
-sub write_back_lexicals {
-    my $avoid = shift || 0;
-    debug "write_back_lexicals($avoid) called from @{[(caller(1))[3]]}\n"
-       if $debug_shadow;
-    my $lex;
-    foreach $lex (@pad) {
-       next unless ref($lex);
-       $lex->write_back unless $lex->{flags} & $avoid;
-    }
-}
-
-sub save_or_restore_lexical_state {
-    my $bblock=shift;
-    unless( exists $lexstate{$bblock}){
-       foreach my $lex (@pad) {
-               next unless ref($lex);
-               ${$lexstate{$bblock}}{$lex->{iv}} = $lex->{flags} ;
-       }
-    }
-    else {
-       foreach my $lex (@pad) {
-           next unless ref($lex);
-           my $old_flags=${$lexstate{$bblock}}{$lex->{iv}}  ;
-           next if ( $old_flags eq $lex->{flags});
-           if  (($old_flags & VALID_SV)  && !($lex->{flags} & VALID_SV)){
-               $lex->write_back;
-           }
-           if (($old_flags & VALID_DOUBLE) && !($lex->{flags} & VALID_DOUBLE)){
-                $lex->load_double;
-            }
-            if (($old_flags & VALID_INT) && !($lex->{flags} & VALID_INT)){
-                $lex->load_int;
-            }
-        }
-    }
-}
-
-sub write_back_stack {
-    my $obj;
-    return unless @stack;
-    runtime(sprintf("EXTEND(sp, %d);", scalar(@stack)));
-    foreach $obj (@stack) {
-       runtime(sprintf("PUSHs((SV*)%s);", $obj->as_sv));
-    }
-    @stack = ();
-}
-
-sub invalidate_lexicals {
-    my $avoid = shift || 0;
-    debug "invalidate_lexicals($avoid) called from @{[(caller(1))[3]]}\n"
-       if $debug_shadow;
-    my $lex;
-    foreach $lex (@pad) {
-       next unless ref($lex);
-       $lex->invalidate unless $lex->{flags} & $avoid;
-    }
-}
-
-sub reload_lexicals {
-    my $lex;
-    foreach $lex (@pad) {
-       next unless ref($lex);
-       my $type = $lex->{type};
-       if ($type == T_INT) {
-           $lex->as_int;
-       } elsif ($type == T_DOUBLE) {
-           $lex->as_double;
-       } else {
-           $lex->as_sv;
-       }
-    }
-}
-
-{
-    package B::Pseudoreg;
-    #
-    # This class allocates pseudo-registers (OK, so they're C variables).
-    #
-    my %alloc;         # Keyed by variable name. A value of 1 means the
-                       # variable has been declared. A value of 2 means
-                       # it's in use.
-    
-    sub new_scope { %alloc = () }
-    
-    sub new ($$$) {
-       my ($class, $type, $prefix) = @_;
-       my ($ptr, $i, $varname, $status, $obj);
-       $prefix =~ s/^(\**)//;
-       $ptr = $1;
-       $i = 0;
-       do {
-           $varname = "$prefix$i";
-           $status = $alloc{$varname};
-       } while $status == 2;
-       if ($status != 1) {
-           # Not declared yet
-           B::CC::declare($type, "$ptr$varname");
-           $alloc{$varname} = 2;       # declared and in use
-       }
-       $obj = bless \$varname, $class;
-       return $obj;
-    }
-    sub DESTROY {
-       my $obj = shift;
-       $alloc{$$obj} = 1; # no longer in use but still declared
-    }
-}
-{
-    package B::Shadow;
-    #
-    # This class gives a standard API for a perl object to shadow a
-    # C variable and only generate reloads/write-backs when necessary.
-    #
-    # Use $obj->load($foo) instead of runtime("shadowed_c_var = foo").
-    # Use $obj->write_back whenever shadowed_c_var needs to be up to date.
-    # Use $obj->invalidate whenever an unknown function may have
-    # set shadow itself.
-
-    sub new {
-       my ($class, $write_back) = @_;
-       # Object fields are perl shadow variable, validity flag
-       # (for *C* variable) and callback sub for write_back
-       # (passed perl shadow variable as argument).
-       bless [undef, 1, $write_back], $class;
-    }
-    sub load {
-       my ($obj, $newval) = @_;
-       $obj->[1] = 0;          # C variable no longer valid
-       $obj->[0] = $newval;
-    }
-    sub write_back {
-       my $obj = shift;
-       if (!($obj->[1])) {
-           $obj->[1] = 1;      # C variable will now be valid
-           &{$obj->[2]}($obj->[0]);
-       }
-    }
-    sub invalidate { $_[0]->[1] = 0 } # force C variable to be invalid
-}
-my $curcop = new B::Shadow (sub {
-    my $opsym = shift->save;
-    runtime("PL_curcop = (COP*)$opsym;");
-});
-
-#
-# Context stack shadowing. Mimics stuff in pp_ctl.c, cop.h and so on.
-#
-sub dopoptoloop {
-    my $cxix = $#cxstack;
-    while ($cxix >= 0 && $cxstack[$cxix]->{type} != CXt_LOOP) {
-       $cxix--;
-    }
-    debug "dopoptoloop: returning $cxix" if $debug_cxstack;
-    return $cxix;
-}
-
-sub dopoptolabel {
-    my $label = shift;
-    my $cxix = $#cxstack;
-    while ($cxix >= 0 &&
-          ($cxstack[$cxix]->{type} != CXt_LOOP ||
-           $cxstack[$cxix]->{label} ne $label)) {
-       $cxix--;
-    }
-    debug "dopoptolabel: returning $cxix" if $debug_cxstack;
-    return $cxix;
-}
-
-sub error {
-    my $format = shift;
-    my $file = $curcop->[0]->file;
-    my $line = $curcop->[0]->line;
-    $errors++;
-    if (@_) {
-       warn sprintf("%s:%d: $format\n", $file, $line, @_);
-    } else {
-       warn sprintf("%s:%d: %s\n", $file, $line, $format);
-    }
-}
-
-#
-# Load pad takes (the elements of) a PADLIST as arguments and loads
-# up @pad with Stackobj-derived objects which represent those lexicals.
-# If/when perl itself can generate type information (my int $foo) then
-# we'll take advantage of that here. Until then, we'll use various hacks
-# to tell the compiler when we want a lexical to be a particular type
-# or to be a register.
-#
-sub load_pad {
-    my ($namelistav, $valuelistav) = @_;
-    @padlist = @_;
-    my @namelist = $namelistav->ARRAY;
-    my @valuelist = $valuelistav->ARRAY;
-    my $ix;
-    @pad = ();
-    debug "load_pad: $#namelist names, $#valuelist values\n" if $debug_pad;
-    # Temporary lexicals don't get named so it's possible for @valuelist
-    # to be strictly longer than @namelist. We count $ix up to the end of
-    # @valuelist but index into @namelist for the name. Any temporaries which
-    # run off the end of @namelist will make $namesv undefined and we treat
-    # that the same as having an explicit SPECIAL sv_undef object in @namelist.
-    # [XXX If/when @_ becomes a lexical, we must start at 0 here.]
-    for ($ix = 1; $ix < @valuelist; $ix++) {
-       my $namesv = $namelist[$ix];
-       my $type = T_UNKNOWN;
-       my $flags = 0;
-       my $name = "tmp$ix";
-       my $class = class($namesv);
-       if (!defined($namesv) || $class eq "SPECIAL") {
-           # temporaries have &PL_sv_undef instead of a PVNV for a name
-           $flags = VALID_SV|TEMPORARY|REGISTER;
-       } else {
-           if ($namesv->PV =~ /^\$(.*)_([di])(r?)$/) {
-               $name = $1;
-               if ($2 eq "i") {
-                   $type = T_INT;
-                   $flags = VALID_SV|VALID_INT;
-               } elsif ($2 eq "d") {
-                   $type = T_DOUBLE;
-                   $flags = VALID_SV|VALID_DOUBLE;
-               }
-               $flags |= REGISTER if $3;
-           }
-       }
-       $pad[$ix] = new B::Stackobj::Padsv ($type, $flags, $ix,
-                                           "i_$name", "d_$name");
-
-       debug sprintf("PL_curpad[$ix] = %s\n", $pad[$ix]->peek) if $debug_pad;
-    }
-}
-
-sub declare_pad {
-    my $ix;
-    for ($ix = 1; $ix <= $#pad; $ix++) {
-       my $type = $pad[$ix]->{type};
-       declare("IV", $type == T_INT ? 
-               sprintf("%s=0",$pad[$ix]->{iv}):$pad[$ix]->{iv}) if $pad[$ix]->save_int;
-       declare("double", $type == T_DOUBLE ?
-                sprintf("%s = 0",$pad[$ix]->{nv}):$pad[$ix]->{nv} )if $pad[$ix]->save_double;
-
-    }
-}
-#
-# Debugging stuff
-#
-sub peek_stack { sprintf "stack = %s\n", join(" ", map($_->minipeek, @stack)) }
-
-#
-# OP stuff
-#
-
-sub label {
-    my $op = shift;
-    # XXX Preserve original label name for "real" labels?
-    return sprintf("lab_%x", $$op);
-}
-
-sub write_label {
-    my $op = shift;
-    push_runtime(sprintf("  %s:", label($op)));
-}
-
-sub loadop {
-    my $op = shift;
-    my $opsym = $op->save;
-    runtime("PL_op = $opsym;") unless $know_op;
-    return $opsym;
-}
-
-sub doop {
-    my $op = shift;
-    my $ppname = $op->ppaddr;
-    my $sym = loadop($op);
-    runtime("DOOP($ppname);");
-    $know_op = 1;
-    return $sym;
-}
-
-sub gimme {
-    my $op = shift;
-    my $flags = $op->flags;
-    return (($flags & OPf_WANT) ? (($flags & OPf_WANT)== OPf_WANT_LIST? G_ARRAY:G_SCALAR) : "dowantarray()");
-}
-
-#
-# Code generation for PP code
-#
-
-sub pp_null {
-    my $op = shift;
-    return $op->next;
-}
-
-sub pp_stub {
-    my $op = shift;
-    my $gimme = gimme($op);
-    if ($gimme != G_ARRAY) {
-       my $obj= new B::Stackobj::Const(sv_undef);
-       push(@stack, $obj);
-       # XXX Change to push a constant sv_undef Stackobj onto @stack
-       #write_back_stack();
-       #runtime("if ($gimme != G_ARRAY) XPUSHs(&PL_sv_undef);");
-    }
-    return $op->next;
-}
-
-sub pp_unstack {
-    my $op = shift;
-    @stack = ();
-    runtime("PP_UNSTACK;");
-    return $op->next;
-}
-
-sub pp_and {
-    my $op = shift;
-    my $next = $op->next;
-    reload_lexicals();
-    unshift(@bblock_todo, $next);
-    if (@stack >= 1) {
-       my $bool = pop_bool();
-       write_back_stack();
-        save_or_restore_lexical_state($$next);
-       runtime(sprintf("if (!$bool) {XPUSHs(&PL_sv_no); goto %s;}", label($next)));
-    } else {
-        save_or_restore_lexical_state($$next);
-       runtime(sprintf("if (!%s) goto %s;", top_bool(), label($next)),
-               "*sp--;");
-    }
-    return $op->other;
-}
-           
-sub pp_or {
-    my $op = shift;
-    my $next = $op->next;
-    reload_lexicals();
-    unshift(@bblock_todo, $next);
-    if (@stack >= 1) {
-       my $bool = pop_bool @stack;
-       write_back_stack();
-        save_or_restore_lexical_state($$next);
-       runtime(sprintf("if (%s) { XPUSHs(&PL_sv_yes); goto %s; }",
-                       $bool, label($next)));
-    } else {
-        save_or_restore_lexical_state($$next);
-       runtime(sprintf("if (%s) goto %s;", top_bool(), label($next)),
-               "*sp--;");
-    }
-    return $op->other;
-}
-           
-sub pp_cond_expr {
-    my $op = shift;
-    my $false = $op->next;
-    unshift(@bblock_todo, $false);
-    reload_lexicals();
-    my $bool = pop_bool();
-    write_back_stack();
-    save_or_restore_lexical_state($$false);
-    runtime(sprintf("if (!$bool) goto %s;", label($false)));
-    return $op->other;
-}
-
-sub pp_padsv {
-    my $op = shift;
-    my $ix = $op->targ;
-    push(@stack, $pad[$ix]);
-    if ($op->flags & OPf_MOD) {
-       my $private = $op->private;
-       if ($private & OPpLVAL_INTRO) {
-           runtime("SAVECLEARSV(PL_curpad[$ix]);");
-       } elsif ($private & OPpDEREF) {
-           runtime(sprintf("vivify_ref(PL_curpad[%d], %d);",
-                           $ix, $private & OPpDEREF));
-           $pad[$ix]->invalidate;
-       }
-    }
-    return $op->next;
-}
-
-sub pp_const {
-    my $op = shift;
-    my $sv = $op->sv;
-    my $obj;
-    # constant could be in the pad (under useithreads)
-    if ($$sv) {
-       $obj = $constobj{$$sv};
-       if (!defined($obj)) {
-           $obj = $constobj{$$sv} = new B::Stackobj::Const ($sv);
-       }
-    }
-    else {
-       $obj = $pad[$op->targ];
-    }
-    push(@stack, $obj);
-    return $op->next;
-}
-
-sub pp_nextstate {
-    my $op = shift;
-    $curcop->load($op);
-    @stack = ();
-    debug(sprintf("%s:%d\n", $op->file, $op->line)) if $debug_lineno;
-    runtime("TAINT_NOT;") unless $omit_taint;
-    runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;");
-    if ($freetmps_each_bblock || $freetmps_each_loop) {
-       $need_freetmps = 1;
-    } else {
-       runtime("FREETMPS;");
-    }
-    return $op->next;
-}
-
-sub pp_dbstate {
-    my $op = shift;
-    $curcop->invalidate; # XXX?
-    return default_pp($op);
-}
-
-#default_pp will handle this:
-#sub pp_bless { $curcop->write_back; default_pp(@_) }
-#sub pp_repeat { $curcop->write_back; default_pp(@_) }
-# The following subs need $curcop->write_back if we decide to support arybase:
-# pp_pos, pp_substr, pp_index, pp_rindex, pp_aslice, pp_lslice, pp_splice
-#sub pp_caller { $curcop->write_back; default_pp(@_) }
-#sub pp_reset { $curcop->write_back; default_pp(@_) }
-
-sub pp_rv2gv{
-    my $op =shift;
-    $curcop->write_back;
-    write_back_lexicals() unless $skip_lexicals{$ppname};
-    write_back_stack() unless $skip_stack{$ppname};
-    my $sym=doop($op);
-    if ($op->private & OPpDEREF) {
-        $init->add(sprintf("((UNOP *)$sym)->op_first = $sym;"));       
-        $init->add(sprintf("((UNOP *)$sym)->op_type = %d;", 
-               $op->first->type));     
-    }
-    return $op->next;
-}
-sub pp_sort {
-    my $op = shift;
-    my $ppname = $op->ppaddr;
-    if ( $op->flags & OPf_SPECIAL && $op->flags  & OPf_STACKED){   
-        #this indicates the sort BLOCK Array case
-        #ugly surgery required.
-        my $root=$op->first->sibling->first;
-        my $start=$root->first;
-       $op->first->save;
-       $op->first->sibling->save;
-       $root->save;
-       my $sym=$start->save;
-        my $fakeop=cc_queue("pp_sort".$$op,$root,$start);
-       $init->add(sprintf("(%s)->op_next=%s;",$sym,$fakeop));
-    }
-    $curcop->write_back;
-    write_back_lexicals();
-    write_back_stack();
-    doop($op);
-    return $op->next;
-}
-
-sub pp_gv {
-    my $op = shift;
-    my $gvsym;
-    if ($Config{useithreads}) {
-       $gvsym = $pad[$op->padix]->as_sv;
-    }
-    else {
-       $gvsym = $op->gv->save;
-    }
-    write_back_stack();
-    runtime("XPUSHs((SV*)$gvsym);");
-    return $op->next;
-}
-
-sub pp_gvsv {
-    my $op = shift;
-    my $gvsym;
-    if ($Config{useithreads}) {
-       $gvsym = $pad[$op->padix]->as_sv;
-    }
-    else {
-       $gvsym = $op->gv->save;
-    }
-    write_back_stack();
-    if ($op->private & OPpLVAL_INTRO) {
-       runtime("XPUSHs(save_scalar($gvsym));");
-    } else {
-       runtime("XPUSHs(GvSV($gvsym));");
-    }
-    return $op->next;
-}
-
-sub pp_aelemfast {
-    my $op = shift;
-    my $gvsym;
-    if ($Config{useithreads}) {
-       $gvsym = $pad[$op->padix]->as_sv;
-    }
-    else {
-       $gvsym = $op->gv->save;
-    }
-    my $ix = $op->private;
-    my $flag = $op->flags & OPf_MOD;
-    write_back_stack();
-    runtime("svp = av_fetch(GvAV($gvsym), $ix, $flag);",
-           "PUSHs(svp ? *svp : &PL_sv_undef);");
-    return $op->next;
-}
-
-sub int_binop {
-    my ($op, $operator) = @_;
-    if ($op->flags & OPf_STACKED) {
-       my $right = pop_int();
-       if (@stack >= 1) {
-           my $left = top_int();
-           $stack[-1]->set_int(&$operator($left, $right));
-       } else {
-           runtime(sprintf("sv_setiv(TOPs, %s);",&$operator("TOPi", $right)));
-       }
-    } else {
-       my $targ = $pad[$op->targ];
-       my $right = new B::Pseudoreg ("IV", "riv");
-       my $left = new B::Pseudoreg ("IV", "liv");
-       runtime(sprintf("$$right = %s; $$left = %s;", pop_int(), pop_int));
-       $targ->set_int(&$operator($$left, $$right));
-       push(@stack, $targ);
-    }
-    return $op->next;
-}
-
-sub INTS_CLOSED () { 0x1 }
-sub INT_RESULT () { 0x2 }
-sub NUMERIC_RESULT () { 0x4 }
-
-sub numeric_binop {
-    my ($op, $operator, $flags) = @_;
-    my $force_int = 0;
-    $force_int ||= ($flags & INT_RESULT);
-    $force_int ||= ($flags & INTS_CLOSED && @stack >= 2
-                   && valid_int($stack[-2]) && valid_int($stack[-1]));
-    if ($op->flags & OPf_STACKED) {
-       my $right = pop_numeric();
-       if (@stack >= 1) {
-           my $left = top_numeric();
-           if ($force_int) {
-               $stack[-1]->set_int(&$operator($left, $right));
-           } else {
-               $stack[-1]->set_numeric(&$operator($left, $right));
-           }
-       } else {
-           if ($force_int) {
-               my $rightruntime = new B::Pseudoreg ("IV", "riv");
-               runtime(sprintf("$$rightruntime = %s;",$right));
-               runtime(sprintf("sv_setiv(TOPs, %s);",
-                               &$operator("TOPi", $$rightruntime)));
-           } else {
-               my $rightruntime = new B::Pseudoreg ("double", "rnv");
-               runtime(sprintf("$$rightruntime = %s;",$right));
-               runtime(sprintf("sv_setnv(TOPs, %s);",
-                               &$operator("TOPn",$$rightruntime)));
-           }
-       }
-    } else {
-       my $targ = $pad[$op->targ];
-       $force_int ||= ($targ->{type} == T_INT);
-       if ($force_int) {
-           my $right = new B::Pseudoreg ("IV", "riv");
-           my $left = new B::Pseudoreg ("IV", "liv");
-           runtime(sprintf("$$right = %s; $$left = %s;",
-                           pop_numeric(), pop_numeric));
-           $targ->set_int(&$operator($$left, $$right));
-       } else {
-           my $right = new B::Pseudoreg ("double", "rnv");
-           my $left = new B::Pseudoreg ("double", "lnv");
-           runtime(sprintf("$$right = %s; $$left = %s;",
-                           pop_numeric(), pop_numeric));
-           $targ->set_numeric(&$operator($$left, $$right));
-       }
-       push(@stack, $targ);
-    }
-    return $op->next;
-}
-
-sub pp_ncmp {
-    my ($op) = @_;
-    if ($op->flags & OPf_STACKED) {
-       my $right = pop_numeric();
-       if (@stack >= 1) {
-           my $left = top_numeric();
-           runtime sprintf("if (%s > %s){",$left,$right);
-               $stack[-1]->set_int(1);
-           $stack[-1]->write_back();
-           runtime sprintf("}else if (%s < %s ) {",$left,$right);
-               $stack[-1]->set_int(-1);
-           $stack[-1]->write_back();
-           runtime sprintf("}else if (%s == %s) {",$left,$right);
-               $stack[-1]->set_int(0);
-           $stack[-1]->write_back();
-           runtime sprintf("}else {"); 
-               $stack[-1]->set_sv("&PL_sv_undef");
-           runtime "}";
-       } else {
-           my $rightruntime = new B::Pseudoreg ("double", "rnv");
-           runtime(sprintf("$$rightruntime = %s;",$right));
-           runtime sprintf(qq/if ("TOPn" > %s){/,$rightruntime);
-           runtime sprintf("sv_setiv(TOPs,1);");
-           runtime sprintf(qq/}else if ( "TOPn" < %s ) {/,$$rightruntime);
-           runtime sprintf("sv_setiv(TOPs,-1);");
-           runtime sprintf(qq/} else if ("TOPn" == %s) {/,$$rightruntime);
-           runtime sprintf("sv_setiv(TOPs,0);");
-           runtime sprintf(qq/}else {/); 
-           runtime sprintf("sv_setiv(TOPs,&PL_sv_undef;");
-           runtime "}";
-       }
-    } else {
-               my $targ = $pad[$op->targ];
-        my $right = new B::Pseudoreg ("double", "rnv");
-        my $left = new B::Pseudoreg ("double", "lnv");
-        runtime(sprintf("$$right = %s; $$left = %s;",
-                           pop_numeric(), pop_numeric));
-       runtime sprintf("if (%s > %s){",$$left,$$right);
-               $targ->set_int(1);
-               $targ->write_back();
-       runtime sprintf("}else if (%s < %s ) {",$$left,$$right);
-               $targ->set_int(-1);
-               $targ->write_back();
-       runtime sprintf("}else if (%s == %s) {",$$left,$$right);
-               $targ->set_int(0);
-               $targ->write_back();
-       runtime sprintf("}else {"); 
-               $targ->set_sv("&PL_sv_undef");
-       runtime "}";
-       push(@stack, $targ);
-    }
-    return $op->next;
-}
-
-sub sv_binop {
-    my ($op, $operator, $flags) = @_;
-    if ($op->flags & OPf_STACKED) {
-       my $right = pop_sv();
-       if (@stack >= 1) {
-           my $left = top_sv();
-           if ($flags & INT_RESULT) {
-               $stack[-1]->set_int(&$operator($left, $right));
-           } elsif ($flags & NUMERIC_RESULT) {
-               $stack[-1]->set_numeric(&$operator($left, $right));
-           } else {
-               # XXX Does this work?
-               runtime(sprintf("sv_setsv($left, %s);",
-                               &$operator($left, $right)));
-               $stack[-1]->invalidate;
-           }
-       } else {
-           my $f;
-           if ($flags & INT_RESULT) {
-               $f = "sv_setiv";
-           } elsif ($flags & NUMERIC_RESULT) {
-               $f = "sv_setnv";
-           } else {
-               $f = "sv_setsv";
-           }
-           runtime(sprintf("%s(TOPs, %s);", $f, &$operator("TOPs", $right)));
-       }
-    } else {
-       my $targ = $pad[$op->targ];
-       runtime(sprintf("right = %s; left = %s;", pop_sv(), pop_sv));
-       if ($flags & INT_RESULT) {
-           $targ->set_int(&$operator("left", "right"));
-       } elsif ($flags & NUMERIC_RESULT) {
-           $targ->set_numeric(&$operator("left", "right"));
-       } else {
-           # XXX Does this work?
-           runtime(sprintf("sv_setsv(%s, %s);",
-                           $targ->as_sv, &$operator("left", "right")));
-           $targ->invalidate;
-       }
-       push(@stack, $targ);
-    }
-    return $op->next;
-}
-    
-sub bool_int_binop {
-    my ($op, $operator) = @_;
-    my $right = new B::Pseudoreg ("IV", "riv");
-    my $left = new B::Pseudoreg ("IV", "liv");
-    runtime(sprintf("$$right = %s; $$left = %s;", pop_int(), pop_int()));
-    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
-    $bool->set_int(&$operator($$left, $$right));
-    push(@stack, $bool);
-    return $op->next;
-}
-
-sub bool_numeric_binop {
-    my ($op, $operator) = @_;
-    my $right = new B::Pseudoreg ("double", "rnv");
-    my $left = new B::Pseudoreg ("double", "lnv");
-    runtime(sprintf("$$right = %s; $$left = %s;",
-                   pop_numeric(), pop_numeric()));
-    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
-    $bool->set_numeric(&$operator($$left, $$right));
-    push(@stack, $bool);
-    return $op->next;
-}
-
-sub bool_sv_binop {
-    my ($op, $operator) = @_;
-    runtime(sprintf("right = %s; left = %s;", pop_sv(), pop_sv()));
-    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
-    $bool->set_numeric(&$operator("left", "right"));
-    push(@stack, $bool);
-    return $op->next;
-}
-
-sub infix_op {
-    my $opname = shift;
-    return sub { "$_[0] $opname $_[1]" }
-}
-
-sub prefix_op {
-    my $opname = shift;
-    return sub { sprintf("%s(%s)", $opname, join(", ", @_)) }
-}
-
-BEGIN {
-    my $plus_op = infix_op("+");
-    my $minus_op = infix_op("-");
-    my $multiply_op = infix_op("*");
-    my $divide_op = infix_op("/");
-    my $modulo_op = infix_op("%");
-    my $lshift_op = infix_op("<<");
-    my $rshift_op = infix_op(">>");
-    my $scmp_op = prefix_op("sv_cmp");
-    my $seq_op = prefix_op("sv_eq");
-    my $sne_op = prefix_op("!sv_eq");
-    my $slt_op = sub { "sv_cmp($_[0], $_[1]) < 0" };
-    my $sgt_op = sub { "sv_cmp($_[0], $_[1]) > 0" };
-    my $sle_op = sub { "sv_cmp($_[0], $_[1]) <= 0" };
-    my $sge_op = sub { "sv_cmp($_[0], $_[1]) >= 0" };
-    my $eq_op = infix_op("==");
-    my $ne_op = infix_op("!=");
-    my $lt_op = infix_op("<");
-    my $gt_op = infix_op(">");
-    my $le_op = infix_op("<=");
-    my $ge_op = infix_op(">=");
-
-    #
-    # XXX The standard perl PP code has extra handling for
-    # some special case arguments of these operators.
-    #
-    sub pp_add { numeric_binop($_[0], $plus_op) }
-    sub pp_subtract { numeric_binop($_[0], $minus_op) }
-    sub pp_multiply { numeric_binop($_[0], $multiply_op) }
-    sub pp_divide { numeric_binop($_[0], $divide_op) }
-    sub pp_modulo { int_binop($_[0], $modulo_op) } # differs from perl's
-
-    sub pp_left_shift { int_binop($_[0], $lshift_op) }
-    sub pp_right_shift { int_binop($_[0], $rshift_op) }
-    sub pp_i_add { int_binop($_[0], $plus_op) }
-    sub pp_i_subtract { int_binop($_[0], $minus_op) }
-    sub pp_i_multiply { int_binop($_[0], $multiply_op) }
-    sub pp_i_divide { int_binop($_[0], $divide_op) }
-    sub pp_i_modulo { int_binop($_[0], $modulo_op) }
-
-    sub pp_eq { bool_numeric_binop($_[0], $eq_op) }
-    sub pp_ne { bool_numeric_binop($_[0], $ne_op) }
-    sub pp_lt { bool_numeric_binop($_[0], $lt_op) }
-    sub pp_gt { bool_numeric_binop($_[0], $gt_op) }
-    sub pp_le { bool_numeric_binop($_[0], $le_op) }
-    sub pp_ge { bool_numeric_binop($_[0], $ge_op) }
-
-    sub pp_i_eq { bool_int_binop($_[0], $eq_op) }
-    sub pp_i_ne { bool_int_binop($_[0], $ne_op) }
-    sub pp_i_lt { bool_int_binop($_[0], $lt_op) }
-    sub pp_i_gt { bool_int_binop($_[0], $gt_op) }
-    sub pp_i_le { bool_int_binop($_[0], $le_op) }
-    sub pp_i_ge { bool_int_binop($_[0], $ge_op) }
-
-    sub pp_scmp { sv_binop($_[0], $scmp_op, INT_RESULT) }
-    sub pp_slt { bool_sv_binop($_[0], $slt_op) }
-    sub pp_sgt { bool_sv_binop($_[0], $sgt_op) }
-    sub pp_sle { bool_sv_binop($_[0], $sle_op) }
-    sub pp_sge { bool_sv_binop($_[0], $sge_op) }
-    sub pp_seq { bool_sv_binop($_[0], $seq_op) }
-    sub pp_sne { bool_sv_binop($_[0], $sne_op) }
-}
-
-
-sub pp_sassign {
-    my $op = shift;
-    my $backwards = $op->private & OPpASSIGN_BACKWARDS;
-    my ($dst, $src);
-    if (@stack >= 2) {
-       $dst = pop @stack;
-       $src = pop @stack;
-       ($src, $dst) = ($dst, $src) if $backwards;
-       my $type = $src->{type};
-       if ($type == T_INT) {
-           $dst->set_int($src->as_int,$src->{flags} & VALID_UNSIGNED);
-       } elsif ($type == T_DOUBLE) {
-           $dst->set_numeric($src->as_numeric);
-       } else {
-           $dst->set_sv($src->as_sv);
-       }
-       push(@stack, $dst);
-    } elsif (@stack == 1) {
-       if ($backwards) {
-           my $src = pop @stack;
-           my $type = $src->{type};
-           runtime("if (PL_tainting && PL_tainted) TAINT_NOT;");
-           if ($type == T_INT) {
-                if ($src->{flags} & VALID_UNSIGNED){ 
-                     runtime sprintf("sv_setuv(TOPs, %s);", $src->as_int);
-                }else{
-                    runtime sprintf("sv_setiv(TOPs, %s);", $src->as_int);
-                }
-           } elsif ($type == T_DOUBLE) {
-               runtime sprintf("sv_setnv(TOPs, %s);", $src->as_double);
-           } else {
-               runtime sprintf("sv_setsv(TOPs, %s);", $src->as_sv);
-           }
-           runtime("SvSETMAGIC(TOPs);");
-       } else {
-           my $dst = $stack[-1];
-           my $type = $dst->{type};
-           runtime("sv = POPs;");
-           runtime("MAYBE_TAINT_SASSIGN_SRC(sv);");
-           if ($type == T_INT) {
-               $dst->set_int("SvIV(sv)");
-           } elsif ($type == T_DOUBLE) {
-               $dst->set_double("SvNV(sv)");
-           } else {
-               runtime("SvSetMagicSV($dst->{sv}, sv);");
-               $dst->invalidate;
-           }
-       }
-    } else {
-       if ($backwards) {
-           runtime("src = POPs; dst = TOPs;");
-       } else {
-           runtime("dst = POPs; src = TOPs;");
-       }
-       runtime("MAYBE_TAINT_SASSIGN_SRC(src);",
-               "SvSetSV(dst, src);",
-               "SvSETMAGIC(dst);",
-               "SETs(dst);");
-    }
-    return $op->next;
-}
-
-sub pp_preinc {
-    my $op = shift;
-    if (@stack >= 1) {
-       my $obj = $stack[-1];
-       my $type = $obj->{type};
-       if ($type == T_INT || $type == T_DOUBLE) {
-           $obj->set_int($obj->as_int . " + 1");
-       } else {
-           runtime sprintf("PP_PREINC(%s);", $obj->as_sv);
-           $obj->invalidate();
-       }
-    } else {
-       runtime sprintf("PP_PREINC(TOPs);");
-    }
-    return $op->next;
-}
-
-
-sub pp_pushmark {
-    my $op = shift;
-    write_back_stack();
-    runtime("PUSHMARK(sp);");
-    return $op->next;
-}
-
-sub pp_list {
-    my $op = shift;
-    write_back_stack();
-    my $gimme = gimme($op);
-    if ($gimme == G_ARRAY) { # sic
-       runtime("POPMARK;"); # need this even though not a "full" pp_list
-    } else {
-       runtime("PP_LIST($gimme);");
-    }
-    return $op->next;
-}
-
-sub pp_entersub {
-    my $op = shift;
-    $curcop->write_back;
-    write_back_lexicals(REGISTER|TEMPORARY);
-    write_back_stack();
-    my $sym = doop($op);
-    runtime("while (PL_op != ($sym)->op_next && PL_op != (OP*)0 ){");
-    runtime("PL_op = (*PL_op->op_ppaddr)(aTHX);");
-    runtime("SPAGAIN;}");
-    $know_op = 0;
-    invalidate_lexicals(REGISTER|TEMPORARY);
-    return $op->next;
-}
-sub pp_formline {
-    my $op = shift;
-    my $ppname = $op->ppaddr;
-    write_back_lexicals() unless $skip_lexicals{$ppname};
-    write_back_stack() unless $skip_stack{$ppname};
-    my $sym=doop($op);
-    # See comment in pp_grepwhile to see why!
-    $init->add("((LISTOP*)$sym)->op_first = $sym;");    
-    runtime("if (PL_op == ((LISTOP*)($sym))->op_first){");
-    save_or_restore_lexical_state(${$op->first});
-    runtime( sprintf("goto %s;",label($op->first)));
-    runtime("}");
-    return $op->next;
-}
-
-sub pp_goto{
-
-    my $op = shift;
-    my $ppname = $op->ppaddr;
-    write_back_lexicals() unless $skip_lexicals{$ppname};
-    write_back_stack() unless $skip_stack{$ppname};
-    my $sym=doop($op);
-    runtime("if (PL_op != ($sym)->op_next && PL_op != (OP*)0){return PL_op;}");
-    invalidate_lexicals() unless $skip_invalidate{$ppname};
-    return $op->next;
-}
-sub pp_enterwrite {
-    my $op = shift;
-    pp_entersub($op);
-}
-sub pp_leavesub{
-    my $op = shift;
-    write_back_lexicals() unless $skip_lexicals{$ppname};
-    write_back_stack() unless $skip_stack{$ppname};
-    runtime("if (PL_curstackinfo->si_type == PERLSI_SORT){");   
-    runtime("\tPUTBACK;return 0;");
-    runtime("}");
-    doop($op);
-    return $op->next;
-}
-sub pp_leavewrite {
-    my $op = shift;
-    write_back_lexicals(REGISTER|TEMPORARY);
-    write_back_stack();
-    my $sym = doop($op);
-    # XXX Is this the right way to distinguish between it returning
-    # CvSTART(cv) (via doform) and pop_return()?
-    #runtime("if (PL_op) PL_op = (*PL_op->op_ppaddr)(aTHX);");
-    runtime("SPAGAIN;");
-    $know_op = 0;
-    invalidate_lexicals(REGISTER|TEMPORARY);
-    return $op->next;
-}
-
-sub doeval {
-    my $op = shift;
-    $curcop->write_back;
-    write_back_lexicals(REGISTER|TEMPORARY);
-    write_back_stack();
-    my $sym = loadop($op);
-    my $ppaddr = $op->ppaddr;
-    #runtime(qq/printf("$ppaddr type eval\n");/);
-    runtime("PP_EVAL($ppaddr, ($sym)->op_next);");
-    $know_op = 1;
-    invalidate_lexicals(REGISTER|TEMPORARY);
-    return $op->next;
-}
-
-sub pp_entereval { doeval(@_) }
-sub pp_dofile { doeval(@_) }
-
-#pp_require is protected by pp_entertry, so no protection for it.
-sub pp_require {
-    my $op = shift;
-    $curcop->write_back;
-    write_back_lexicals(REGISTER|TEMPORARY);
-    write_back_stack();
-    my $sym = doop($op);
-    runtime("while (PL_op != ($sym)->op_next && PL_op != (OP*)0 ){");
-    runtime("PL_op = (*PL_op->op_ppaddr)(ARGS);");
-    runtime("SPAGAIN;}");
-    $know_op = 1;
-    invalidate_lexicals(REGISTER|TEMPORARY);
-    return $op->next;
-}
-
-
-sub pp_entertry {
-    my $op = shift;
-    $curcop->write_back;
-    write_back_lexicals(REGISTER|TEMPORARY);
-    write_back_stack();
-    my $sym = doop($op);
-    my $jmpbuf = sprintf("jmpbuf%d", $jmpbuf_ix++);
-    declare("JMPENV", $jmpbuf);
-    runtime(sprintf("PP_ENTERTRY(%s,%s);", $jmpbuf, label($op->other->next)));
-    invalidate_lexicals(REGISTER|TEMPORARY);
-    return $op->next;
-}
-
-sub pp_leavetry{
-       my $op=shift;
-       default_pp($op);
-       runtime("PP_LEAVETRY;");
-       return $op->next;
-}
-
-sub pp_grepstart {
-    my $op = shift;
-    if ($need_freetmps && $freetmps_each_loop) {
-       runtime("FREETMPS;"); # otherwise the grepwhile loop messes things up
-       $need_freetmps = 0;
-    }
-    write_back_stack();
-    my $sym= doop($op);
-    my $next=$op->next;
-    $next->save;
-    my $nexttonext=$next->next;
-    $nexttonext->save;
-    save_or_restore_lexical_state($$nexttonext);
-    runtime(sprintf("if (PL_op == (($sym)->op_next)->op_next) goto %s;",
-                   label($nexttonext)));
-    return $op->next->other;
-}
-
-sub pp_mapstart {
-    my $op = shift;
-    if ($need_freetmps && $freetmps_each_loop) {
-       runtime("FREETMPS;"); # otherwise the mapwhile loop messes things up
-       $need_freetmps = 0;
-    }
-    write_back_stack();
-    # pp_mapstart can return either op_next->op_next or op_next->op_other and
-    # we need to be able to distinguish the two at runtime. 
-    my $sym= doop($op);
-    my $next=$op->next;
-    $next->save;
-    my $nexttonext=$next->next;
-    $nexttonext->save;
-    save_or_restore_lexical_state($$nexttonext);
-    runtime(sprintf("if (PL_op == (($sym)->op_next)->op_next) goto %s;",
-                   label($nexttonext)));
-    return $op->next->other;
-}
-
-sub pp_grepwhile {
-    my $op = shift;
-    my $next = $op->next;
-    unshift(@bblock_todo, $next);
-    write_back_lexicals();
-    write_back_stack();
-    my $sym = doop($op);
-    # pp_grepwhile can return either op_next or op_other and we need to
-    # be able to distinguish the two at runtime. Since it's possible for
-    # both ops to be "inlined", the fields could both be zero. To get
-    # around that, we hack op_next to be our own op (purely because we
-    # know it's a non-NULL pointer and can't be the same as op_other).
-    $init->add("((LOGOP*)$sym)->op_next = $sym;");
-    save_or_restore_lexical_state($$next);
-    runtime(sprintf("if (PL_op == ($sym)->op_next) goto %s;", label($next)));
-    $know_op = 0;
-    return $op->other;
-}
-
-sub pp_mapwhile {
-    pp_grepwhile(@_);
-}
-
-sub pp_return {
-    my $op = shift;
-    write_back_lexicals(REGISTER|TEMPORARY);
-    write_back_stack();
-    doop($op);
-    runtime("PUTBACK;", "return PL_op;");
-    $know_op = 0;
-    return $op->next;
-}
-
-sub nyi {
-    my $op = shift;
-    warn sprintf("%s not yet implemented properly\n", $op->ppaddr);
-    return default_pp($op);
-}
-
-sub pp_range {
-    my $op = shift;
-    my $flags = $op->flags;
-    if (!($flags & OPf_WANT)) {
-       error("context of range unknown at compile-time");
-    }
-    write_back_lexicals();
-    write_back_stack();
-    unless (($flags & OPf_WANT)== OPf_WANT_LIST) {
-       # We need to save our UNOP structure since pp_flop uses
-       # it to find and adjust out targ. We don't need it ourselves.
-       $op->save;
-        save_or_restore_lexical_state(${$op->other});
-       runtime sprintf("if (SvTRUE(PL_curpad[%d])) goto %s;",
-                       $op->targ, label($op->other));
-       unshift(@bblock_todo, $op->other);
-    }
-    return $op->next;
-}
-
-sub pp_flip {
-    my $op = shift;
-    my $flags = $op->flags;
-    if (!($flags & OPf_WANT)) {
-       error("context of flip unknown at compile-time");
-    }
-    if (($flags & OPf_WANT)==OPf_WANT_LIST) {
-       return $op->first->other;
-    }
-    write_back_lexicals();
-    write_back_stack();
-    # We need to save our UNOP structure since pp_flop uses
-    # it to find and adjust out targ. We don't need it ourselves.
-    $op->save;
-    my $ix = $op->targ;
-    my $rangeix = $op->first->targ;
-    runtime(($op->private & OPpFLIP_LINENUM) ?
-           "if (PL_last_in_gv && SvIV(TOPs) == IoLINES(GvIOp(PL_last_in_gv))) {"
-         : "if (SvTRUE(TOPs)) {");
-    runtime("\tsv_setiv(PL_curpad[$rangeix], 1);");
-    if ($op->flags & OPf_SPECIAL) {
-       runtime("sv_setiv(PL_curpad[$ix], 1);");
-    } else {
-       save_or_restore_lexical_state(${$op->first->other});
-       runtime("\tsv_setiv(PL_curpad[$ix], 0);",
-               "\tsp--;",
-               sprintf("\tgoto %s;", label($op->first->other)));
-    }
-    runtime("}",
-         qq{sv_setpv(PL_curpad[$ix], "");},
-           "SETs(PL_curpad[$ix]);");
-    $know_op = 0;
-    return $op->next;
-}
-
-sub pp_flop {
-    my $op = shift;
-    default_pp($op);
-    $know_op = 0;
-    return $op->next;
-}
-
-sub enterloop {
-    my $op = shift;
-    my $nextop = $op->nextop;
-    my $lastop = $op->lastop;
-    my $redoop = $op->redoop;
-    $curcop->write_back;
-    debug "enterloop: pushing on cxstack" if $debug_cxstack;
-    push(@cxstack, {
-       type => CXt_LOOP,
-       op => $op,
-       "label" => $curcop->[0]->label,
-       nextop => $nextop,
-       lastop => $lastop,
-       redoop => $redoop
-    });
-    $nextop->save;
-    $lastop->save;
-    $redoop->save;
-    return default_pp($op);
-}
-
-sub pp_enterloop { enterloop(@_) }
-sub pp_enteriter { enterloop(@_) }
-
-sub pp_leaveloop {
-    my $op = shift;
-    if (!@cxstack) {
-       die "panic: leaveloop";
-    }
-    debug "leaveloop: popping from cxstack" if $debug_cxstack;
-    pop(@cxstack);
-    return default_pp($op);
-}
-
-sub pp_next {
-    my $op = shift;
-    my $cxix;
-    if ($op->flags & OPf_SPECIAL) {
-       $cxix = dopoptoloop();
-       if ($cxix < 0) {
-           error('"next" used outside loop');
-           return $op->next; # ignore the op
-       }
-    } else {
-       $cxix = dopoptolabel($op->pv);
-       if ($cxix < 0) {
-           error('Label not found at compile time for "next %s"', $op->pv);
-           return $op->next; # ignore the op
-       }
-    }
-    default_pp($op);
-    my $nextop = $cxstack[$cxix]->{nextop};
-    push(@bblock_todo, $nextop);
-    save_or_restore_lexical_state($$nextop);
-    runtime(sprintf("goto %s;", label($nextop)));
-    return $op->next;
-}
-
-sub pp_redo {
-    my $op = shift;
-    my $cxix;
-    if ($op->flags & OPf_SPECIAL) {
-       $cxix = dopoptoloop();
-       if ($cxix < 0) {
-           error('"redo" used outside loop');
-           return $op->next; # ignore the op
-       }
-    } else {
-       $cxix = dopoptolabel($op->pv);
-       if ($cxix < 0) {
-           error('Label not found at compile time for "redo %s"', $op->pv);
-           return $op->next; # ignore the op
-       }
-    }
-    default_pp($op);
-    my $redoop = $cxstack[$cxix]->{redoop};
-    push(@bblock_todo, $redoop);
-    save_or_restore_lexical_state($$redoop);
-    runtime(sprintf("goto %s;", label($redoop)));
-    return $op->next;
-}
-
-sub pp_last {
-    my $op = shift;
-    my $cxix;
-    if ($op->flags & OPf_SPECIAL) {
-       $cxix = dopoptoloop();
-       if ($cxix < 0) {
-           error('"last" used outside loop');
-           return $op->next; # ignore the op
-       }
-    } else {
-       $cxix = dopoptolabel($op->pv);
-       if ($cxix < 0) {
-           error('Label not found at compile time for "last %s"', $op->pv);
-           return $op->next; # ignore the op
-       }
-       # XXX Add support for "last" to leave non-loop blocks
-       if ($cxstack[$cxix]->{type} != CXt_LOOP) {
-           error('Use of "last" for non-loop blocks is not yet implemented');
-           return $op->next; # ignore the op
-       }
-    }
-    default_pp($op);
-    my $lastop = $cxstack[$cxix]->{lastop}->next;
-    push(@bblock_todo, $lastop);
-    save_or_restore_lexical_state($$lastop);
-    runtime(sprintf("goto %s;", label($lastop)));
-    return $op->next;
-}
-
-sub pp_subst {
-    my $op = shift;
-    write_back_lexicals();
-    write_back_stack();
-    my $sym = doop($op);
-    my $replroot = $op->pmreplroot;
-    if ($$replroot) {
-        save_or_restore_lexical_state($$replroot);
-       runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplroot) goto %s;",
-                       $sym, label($replroot));
-       $op->pmreplstart->save;
-       push(@bblock_todo, $replroot);
-    }
-    invalidate_lexicals();
-    return $op->next;
-}
-
-sub pp_substcont {
-    my $op = shift;
-    write_back_lexicals();
-    write_back_stack();
-    doop($op);
-    my $pmop = $op->other;
-    # warn sprintf("substcont: op = %s, pmop = %s\n",
-    #           peekop($op), peekop($pmop));#debug
-#   my $pmopsym = objsym($pmop);
-    my $pmopsym = $pmop->save; # XXX can this recurse?
-#   warn "pmopsym = $pmopsym\n";#debug
-    save_or_restore_lexical_state(${$pmop->pmreplstart});
-    runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplstart) goto %s;",
-                   $pmopsym, label($pmop->pmreplstart));
-    invalidate_lexicals();
-    return $pmop->next;
-}
-
-sub default_pp {
-    my $op = shift;
-    my $ppname = "pp_" . $op->name;
-    if ($curcop and $need_curcop{$ppname}){
-       $curcop->write_back;
-    }
-    write_back_lexicals() unless $skip_lexicals{$ppname};
-    write_back_stack() unless $skip_stack{$ppname};
-    doop($op);
-    # XXX If the only way that ops can write to a TEMPORARY lexical is
-    # when it's named in $op->targ then we could call
-    # invalidate_lexicals(TEMPORARY) and avoid having to write back all
-    # the temporaries. For now, we'll play it safe and write back the lot.
-    invalidate_lexicals() unless $skip_invalidate{$ppname};
-    return $op->next;
-}
-
-sub compile_op {
-    my $op = shift;
-    my $ppname = "pp_" . $op->name;
-    if (exists $ignore_op{$ppname}) {
-       return $op->next;
-    }
-    debug peek_stack() if $debug_stack;
-    if ($debug_op) {
-       debug sprintf("%s [%s]\n",
-                    peekop($op),
-                    $op->flags & OPf_STACKED ? "OPf_STACKED" : $op->targ);
-    }
-    no strict 'refs';
-    if (defined(&$ppname)) {
-       $know_op = 0;
-       return &$ppname($op);
-    } else {
-       return default_pp($op);
-    }
-}
-
-sub compile_bblock {
-    my $op = shift;
-    #warn "compile_bblock: ", peekop($op), "\n"; # debug
-    save_or_restore_lexical_state($$op);
-    write_label($op);
-    $know_op = 0;
-    do {
-       $op = compile_op($op);
-    } while (defined($op) && $$op && !exists($leaders->{$$op}));
-    write_back_stack(); # boo hoo: big loss
-    reload_lexicals();
-    return $op;
-}
-
-sub cc {
-    my ($name, $root, $start, @padlist) = @_;
-    my $op;
-    if($done{$$start}){ 
-       #warn "repeat=>".ref($start)."$name,\n";#debug
-       $decl->add(sprintf("#define $name  %s",$done{$$start}));
-       return;
-    }
-    init_pp($name);
-    load_pad(@padlist);
-    %lexstate=();
-    B::Pseudoreg->new_scope;
-    @cxstack = ();
-    if ($debug_timings) {
-       warn sprintf("Basic block analysis at %s\n", timing_info);
-    }
-    $leaders = find_leaders($root, $start);
-    my @leaders= keys %$leaders; 
-    if ($#leaders > -1) { 
-       @bblock_todo = ($start, values %$leaders) ;
-    } else{
-       runtime("return PL_op?PL_op->op_next:0;");
-    }
-    if ($debug_timings) {
-       warn sprintf("Compilation at %s\n", timing_info);
-    }
-    while (@bblock_todo) {
-       $op = shift @bblock_todo;
-       #warn sprintf("Considering basic block %s\n", peekop($op)); # debug
-       next if !defined($op) || !$$op || $done{$$op};
-       #warn "...compiling it\n"; # debug
-       do {
-           $done{$$op} = $name;
-           $op = compile_bblock($op);
-           if ($need_freetmps && $freetmps_each_bblock) {
-               runtime("FREETMPS;");
-               $need_freetmps = 0;
-           }
-       } while defined($op) && $$op && !$done{$$op};
-       if ($need_freetmps && $freetmps_each_loop) {
-           runtime("FREETMPS;");
-           $need_freetmps = 0;
-       }
-       if (!$$op) {
-           runtime("PUTBACK;","return PL_op;");
-       } elsif ($done{$$op}) {
-           save_or_restore_lexical_state($$op);
-           runtime(sprintf("goto %s;", label($op)));
-       }
-    }
-    if ($debug_timings) {
-       warn sprintf("Saving runtime at %s\n", timing_info);
-    }
-    declare_pad(@padlist) ;
-    save_runtime();
-}
-
-sub cc_recurse {
-    my $ccinfo;
-    my $start;
-    $start = cc_queue(@_) if @_;
-    while ($ccinfo = shift @cc_todo) {
-       cc(@$ccinfo);
-    }
-    return $start;
-}    
-
-sub cc_obj {
-    my ($name, $cvref) = @_;
-    my $cv = svref_2object($cvref);
-    my @padlist = $cv->PADLIST->ARRAY;
-    my $curpad_sym = $padlist[1]->save;
-    cc_recurse($name, $cv->ROOT, $cv->START, @padlist);
-}
-
-sub cc_main {
-    my @comppadlist = comppadlist->ARRAY;
-    my $curpad_nam  = $comppadlist[0]->save;
-    my $curpad_sym  = $comppadlist[1]->save;
-    my $init_av     = init_av->save; 
-    my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
-    # Do save_unused_subs before saving inc_hv
-    save_unused_subs();
-    cc_recurse();
-
-    my $inc_hv      = svref_2object(\%INC)->save;
-    my $inc_av      = svref_2object(\@INC)->save;
-    my $amagic_generate= amagic_generation;
-    return if $errors;
-    if (!defined($module)) {
-       $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
-                  "PL_main_start = $start;",
-                  "PL_curpad = AvARRAY($curpad_sym);",
-                  "PL_initav = (AV *) $init_av;",
-                  "GvHV(PL_incgv) = $inc_hv;",
-                  "GvAV(PL_incgv) = $inc_av;",
-                  "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
-                  "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));",
-                  "PL_amagic_generation= $amagic_generate;",
-                    );
-                 
-    }
-    seek(STDOUT,0,0); #prevent print statements from BEGIN{} into the output
-    output_boilerplate();
-    print "\n";
-    output_all("perl_init");
-    output_runtime();
-    print "\n";
-    output_main();
-    if (defined($module)) {
-       my $cmodule = $module;
-       $cmodule =~ s/::/__/g;
-       print <<"EOT";
-
-#include "XSUB.h"
-XS(boot_$cmodule)
-{
-    dXSARGS;
-    perl_init();
-    ENTER;
-    SAVETMPS;
-    SAVEVPTR(PL_curpad);
-    SAVEVPTR(PL_op);
-    PL_curpad = AvARRAY($curpad_sym);
-    PL_op = $start;
-    pp_main(aTHX);
-    FREETMPS;
-    LEAVE;
-    ST(0) = &PL_sv_yes;
-    XSRETURN(1);
-}
-EOT
-    }
-    if ($debug_timings) {
-       warn sprintf("Done at %s\n", timing_info);
-    }
-}
-
-sub compile {
-    my @options = @_;
-    my ($option, $opt, $arg);
-  OPTION:
-    while ($option = shift @options) {
-       if ($option =~ /^-(.)(.*)/) {
-           $opt = $1;
-           $arg = $2;
-       } else {
-           unshift @options, $option;
-           last OPTION;
-       }
-       if ($opt eq "-" && $arg eq "-") {
-           shift @options;
-           last OPTION;
-       } elsif ($opt eq "o") {
-           $arg ||= shift @options;
-           open(STDOUT, ">$arg") or return "open '>$arg': $!\n";
-       } elsif ($opt eq "n") {
-           $arg ||= shift @options;
-           $module_name = $arg;
-       } elsif ($opt eq "u") {
-           $arg ||= shift @options;
-           mark_unused($arg,undef);
-       } elsif ($opt eq "f") {
-           $arg ||= shift @options;
-           my $value = $arg !~ s/^no-//;
-           $arg =~ s/-/_/g;
-           my $ref = $optimise{$arg};
-           if (defined($ref)) {
-               $$ref = $value;
-           } else {
-               warn qq(ignoring unknown optimisation option "$arg"\n);
-           }
-       } elsif ($opt eq "O") {
-           $arg = 1 if $arg eq "";
-           my $ref;
-           foreach $ref (values %optimise) {
-               $$ref = 0;
-           }
-           if ($arg >= 2) {
-               $freetmps_each_loop = 1;
-           }
-           if ($arg >= 1) {
-               $freetmps_each_bblock = 1 unless $freetmps_each_loop;
-           }
-       } elsif ($opt eq "m") {
-           $arg ||= shift @options;
-           $module = $arg;
-           mark_unused($arg,undef);
-       } elsif ($opt eq "p") {
-           $arg ||= shift @options;
-           $patchlevel = $arg;
-       } elsif ($opt eq "D") {
-            $arg ||= shift @options;
-           foreach $arg (split(//, $arg)) {
-               if ($arg eq "o") {
-                   B->debug(1);
-               } elsif ($arg eq "O") {
-                   $debug_op = 1;
-               } elsif ($arg eq "s") {
-                   $debug_stack = 1;
-               } elsif ($arg eq "c") {
-                   $debug_cxstack = 1;
-               } elsif ($arg eq "p") {
-                   $debug_pad = 1;
-               } elsif ($arg eq "r") {
-                   $debug_runtime = 1;
-               } elsif ($arg eq "S") {
-                   $debug_shadow = 1;
-               } elsif ($arg eq "q") {
-                   $debug_queue = 1;
-               } elsif ($arg eq "l") {
-                   $debug_lineno = 1;
-               } elsif ($arg eq "t") {
-                   $debug_timings = 1;
-               }
-           }
-       }
-    }
-    init_sections();
-    $init = B::Section->get("init");
-    $decl = B::Section->get("decl");
-
-    if (@options) {
-       return sub {
-           my ($objname, $ppname);
-           foreach $objname (@options) {
-               $objname = "main::$objname" unless $objname =~ /::/;
-               ($ppname = $objname) =~ s/^.*?:://;
-               eval "cc_obj(qq(pp_sub_$ppname), \\&$objname)";
-               die "cc_obj(qq(pp_sub_$ppname, \\&$objname) failed: $@" if $@;
-               return if $errors;
-           }
-           output_boilerplate();
-           print "\n";
-           output_all($module_name || "init_module");
-           output_runtime();
-       }
-    } else {
-       return sub { cc_main() };
-    }
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-B::CC - Perl compiler's optimized C translation backend
-
-=head1 SYNOPSIS
-
-       perl -MO=CC[,OPTIONS] foo.pl
-
-=head1 DESCRIPTION
-
-This compiler backend takes Perl source and generates C source code
-corresponding to the flow of your program. In other words, this
-backend is somewhat a "real" compiler in the sense that many people
-think about compilers. Note however that, currently, it is a very
-poor compiler in that although it generates (mostly, or at least
-sometimes) correct code, it performs relatively few optimisations.
-This will change as the compiler develops. The result is that
-running an executable compiled with this backend may start up more
-quickly than running the original Perl program (a feature shared
-by the B<C> compiler backend--see F<B::C>) and may also execute
-slightly faster. This is by no means a good optimising compiler--yet.
-
-=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<-v>
-
-Verbose compilation (currently gives a few compilation statistics).
-
-=item B<-->
-
-Force end of options
-
-=item B<-uPackname>
-
-Force apparently unused subs from package Packname to be compiled.
-This allows programs to use eval "foo()" even when sub foo is never
-seen to be used at compile time. The down side is that any subs which
-really are never used also have code generated. This option is
-necessary, for example, if you have a signal handler foo which you
-initialise with C<$SIG{BAR} = "foo">.  A better fix, though, is just
-to change it to C<$SIG{BAR} = \&foo>. You can have multiple B<-u>
-options. The compiler tries to figure out which packages may possibly
-have subs in which need compiling but the current version doesn't do
-it very well. In particular, it is confused by nested packages (i.e.
-of the form C<A::B>) where package C<A> does not contain any subs.
-
-=item B<-mModulename>
-
-Instead of generating source for a runnable executable, generate
-source for an XSUB module. The boot_Modulename function (which
-DynaLoader can look for) does the appropriate initialisation and runs
-the main part of the Perl source that is being compiled.
-
-
-=item B<-D>
-
-Debug options (concatenated or separate flags like C<perl -D>).
-
-=item B<-Dr>
-
-Writes debugging output to STDERR just as it's about to write to the
-program's runtime (otherwise writes debugging info as comments in
-its C output).
-
-=item B<-DO>
-
-Outputs each OP as it's compiled
-
-=item B<-Ds>
-
-Outputs the contents of the shadow stack at each OP
-
-=item B<-Dp>
-
-Outputs the contents of the shadow pad of lexicals as it's loaded for
-each sub or the main program.
-
-=item B<-Dq>
-
-Outputs the name of each fake PP function in the queue as it's about
-to process it.
-
-=item B<-Dl>
-
-Output the filename and line number of each original line of Perl
-code as it's processed (C<pp_nextstate>).
-
-=item B<-Dt>
-
-Outputs timing information of compilation stages.
-
-=item B<-f>
-
-Force optimisations on or off one at a time.
-
-=item B<-ffreetmps-each-bblock>
-
-Delays FREETMPS from the end of each statement to the end of the each
-basic block.
-
-=item B<-ffreetmps-each-loop>
-
-Delays FREETMPS from the end of each statement to the end of the group
-of basic blocks forming a loop. At most one of the freetmps-each-*
-options can be used.
-
-=item B<-fomit-taint>
-
-Omits generating code for handling perl's tainting mechanism.
-
-=item B<-On>
-
-Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
-Currently, B<-O1> sets B<-ffreetmps-each-bblock> and B<-O2>
-sets B<-ffreetmps-each-loop>.
-
-=back
-
-=head1 EXAMPLES
-
-        perl -MO=CC,-O2,-ofoo.c foo.pl
-        perl cc_harness -o foo foo.c
-
-Note that C<cc_harness> lives in the C<B> subdirectory of your perl
-library directory. The utility called C<perlcc> may also be used to
-help make use of this compiler.
-
-        perl -MO=CC,-mFoo,-oFoo.c Foo.pm
-        perl cc_harness -shared -c -o Foo.so Foo.c
-
-=head1 BUGS
-
-Plenty. Current status: experimental.
-
-=head1 DIFFERENCES
-
-These aren't really bugs but they are constructs which are heavily
-tied to perl's compile-and-go implementation and with which this
-compiler backend cannot cope.
-
-=head2 Loops
-
-Standard perl calculates the target of "next", "last", and "redo"
-at run-time. The compiler calculates the targets at compile-time.
-For example, the program
-
-    sub skip_on_odd { next NUMBER if $_[0] % 2 }
-    NUMBER: for ($i = 0; $i < 5; $i++) {
-        skip_on_odd($i);
-        print $i;
-    }
-
-produces the output
-
-    024
-
-with standard perl but gives a compile-time error with the compiler.
-
-=head2 Context of ".."
-
-The context (scalar or array) of the ".." operator determines whether
-it behaves as a range or a flip/flop. Standard perl delays until
-runtime the decision of which context it is in but the compiler needs
-to know the context at compile-time. For example,
-
-    @a = (4,6,1,0,0,1);
-    sub range { (shift @a)..(shift @a) }
-    print range();
-    while (@a) { print scalar(range()) }
-
-generates the output
-
-    456123E0
-
-with standard Perl but gives a compile-time error with compiled Perl.
-
-=head2 Arithmetic
-
-Compiled Perl programs use native C arithmetic much more frequently
-than standard perl. Operations on large numbers or on boundary
-cases may produce different behaviour.
-
-=head2 Deprecated features
-
-Features of standard perl such as C<$[> which have been deprecated
-in standard perl since Perl5 was released have not been implemented
-in the compiler.
-
-=head1 AUTHOR
-
-Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
-
-=cut
diff --git a/ext/B/B/Disassembler.pm b/ext/B/B/Disassembler.pm
deleted file mode 100644 (file)
index e1993aa..0000000
+++ /dev/null
@@ -1,233 +0,0 @@
-#      Disassembler.pm
-#
-#      Copyright (c) 1996 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.
-
-$B::Disassembler::VERSION = '1.05';
-
-package B::Disassembler::BytecodeStream;
-
-use FileHandle;
-use Carp;
-use Config qw(%Config);
-use B qw(cstring cast_I32);
-@ISA = qw(FileHandle);
-sub readn {
-    my ($fh, $len) = @_;
-    my $data;
-    read($fh, $data, $len);
-    croak "reached EOF while reading $len bytes" unless length($data) == $len;
-    return $data;
-}
-
-sub GET_U8 {
-    my $fh = shift;
-    my $c = $fh->getc;
-    croak "reached EOF while reading U8" unless defined($c);
-    return ord($c);
-}
-
-sub GET_U16 {
-    my $fh = shift;
-    my $str = $fh->readn(2);
-    croak "reached EOF while reading U16" unless length($str) == 2;
-    return unpack("S", $str);
-}
-
-sub GET_NV {
-    my $fh = shift;
-    my ($str, $c);
-    while (defined($c = $fh->getc) && $c ne "\0") {
-        $str .= $c;
-    }
-    croak "reached EOF while reading double" unless defined($c);
-    return $str;
-}
-
-sub GET_U32 {
-    my $fh = shift;
-    my $str = $fh->readn(4);
-    croak "reached EOF while reading U32" unless length($str) == 4;
-    return unpack("L", $str);
-}
-
-sub GET_I32 {
-    my $fh = shift;
-    my $str = $fh->readn(4);
-    croak "reached EOF while reading I32" unless length($str) == 4;
-    return unpack("l", $str);
-}
-
-sub GET_objindex { 
-    my $fh = shift;
-    my $str = $fh->readn(4);
-    croak "reached EOF while reading objindex" unless length($str) == 4;
-    return unpack("L", $str);
-}
-
-sub GET_opindex { 
-    my $fh = shift;
-    my $str = $fh->readn(4);
-    croak "reached EOF while reading opindex" unless length($str) == 4;
-    return unpack("L", $str);
-}
-
-sub GET_svindex { 
-    my $fh = shift;
-    my $str = $fh->readn(4);
-    croak "reached EOF while reading svindex" unless length($str) == 4;
-    return unpack("L", $str);
-}
-
-sub GET_pvindex { 
-    my $fh = shift;
-    my $str = $fh->readn(4);
-    croak "reached EOF while reading pvindex" unless length($str) == 4;
-    return unpack("L", $str);
-}
-
-sub GET_strconst {
-    my $fh = shift;
-    my ($str, $c);
-    $str = '';
-    while (defined($c = $fh->getc) && $c ne "\0") {
-       $str .= $c;
-    }
-    croak "reached EOF while reading strconst" unless defined($c);
-    return cstring($str);
-}
-
-sub GET_pvcontents {}
-
-sub GET_PV {
-    my $fh = shift;
-    my $str;
-    my $len = $fh->GET_U32;
-    if ($len) {
-       read($fh, $str, $len);
-       croak "reached EOF while reading PV" unless length($str) == $len;
-       return cstring($str);
-    } else {
-       return '""';
-    }
-}
-
-sub GET_comment_t {
-    my $fh = shift;
-    my ($str, $c);
-    while (defined($c = $fh->getc) && $c ne "\n") {
-       $str .= $c;
-    }
-    croak "reached EOF while reading comment" unless defined($c);
-    return cstring($str);
-}
-
-sub GET_double {
-    my $fh = shift;
-    my ($str, $c);
-    while (defined($c = $fh->getc) && $c ne "\0") {
-       $str .= $c;
-    }
-    croak "reached EOF while reading double" unless defined($c);
-    return $str;
-}
-
-sub GET_none {}
-
-sub GET_op_tr_array {
-    my $fh = shift;
-    my $len = unpack "S", $fh->readn(2);
-    my @ary = unpack "S*", $fh->readn($len*2);
-    return join(",", $len, @ary);
-}
-
-sub GET_IV64 {
-    my $fh = shift;
-    my $str = $fh->readn(8);
-    croak "reached EOF while reading I32" unless length($str) == 8;
-    return sprintf "0x%09llx", unpack("q", $str);
-}
-
-sub GET_IV {
-    $Config{ivsize} == 4 ? &GET_I32 : &GET_IV64;
-}
-
-sub GET_PADOFFSET {
-    $Config{ptrsize} == 8 ? &GET_IV64 : &GET_U32;
-}
-
-sub GET_long {
-    $Config{longsize} == 8 ? &GET_IV64 : &GET_U32;
-}
-
-
-package B::Disassembler;
-use Exporter;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(disassemble_fh get_header);
-use Carp;
-use strict;
-
-use B::Asmdata qw(%insn_data @insn_name);
-
-our( $magic, $archname, $blversion, $ivsize, $ptrsize );
-
-sub dis_header($){
-    my( $fh ) = @_;
-    $magic = $fh->GET_U32();
-    warn( "bad magic" ) if $magic != 0x43424c50;
-    $archname  = $fh->GET_strconst();
-    $blversion = $fh->GET_strconst();
-    $ivsize    = $fh->GET_U32();
-    $ptrsize   = $fh->GET_U32();
-}
-
-sub get_header(){
-    return( $magic, $archname, $blversion, $ivsize, $ptrsize);
-}
-
-sub disassemble_fh {
-    my ($fh, $out) = @_;
-    my ($c, $getmeth, $insn, $arg);
-    bless $fh, "B::Disassembler::BytecodeStream";
-    dis_header( $fh );
-    while (defined($c = $fh->getc)) {
-       $c = ord($c);
-       $insn = $insn_name[$c];
-       if (!defined($insn) || $insn eq "unused") {
-           my $pos = $fh->tell - 1;
-           die "Illegal instruction code $c at stream offset $pos\n";
-       }
-       $getmeth = $insn_data{$insn}->[2];
-       $arg = $fh->$getmeth();
-       if (defined($arg)) {
-           &$out($insn, $arg);
-       } else {
-           &$out($insn);
-       }
-    }
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-B::Disassembler - Disassemble Perl bytecode
-
-=head1 SYNOPSIS
-
-       use Disassembler;
-
-=head1 DESCRIPTION
-
-See F<ext/B/B/Disassembler.pm>.
-
-=head1 AUTHOR
-
-Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
-
-=cut
diff --git a/ext/B/B/Stackobj.pm b/ext/B/B/Stackobj.pm
deleted file mode 100644 (file)
index b17dfb8..0000000
+++ /dev/null
@@ -1,349 +0,0 @@
-#      Stackobj.pm
-#
-#      Copyright (c) 1996 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::Stackobj;  
-
-our $VERSION = '1.00';
-
-use Exporter ();
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(set_callback T_UNKNOWN T_DOUBLE T_INT VALID_UNSIGNED
-               VALID_INT VALID_DOUBLE VALID_SV REGISTER TEMPORARY);
-%EXPORT_TAGS = (types => [qw(T_UNKNOWN T_DOUBLE T_INT)],
-               flags => [qw(VALID_INT VALID_DOUBLE VALID_SV
-                            VALID_UNSIGNED REGISTER TEMPORARY)]);
-
-use Carp qw(confess);
-use strict;
-use B qw(class SVf_IOK SVf_NOK SVf_IVisUV);
-
-# Types
-sub T_UNKNOWN () { 0 }
-sub T_DOUBLE ()  { 1 }
-sub T_INT ()     { 2 }
-sub T_SPECIAL () { 3 }
-
-# Flags
-sub VALID_INT ()       { 0x01 }
-sub VALID_UNSIGNED ()  { 0x02 }
-sub VALID_DOUBLE ()    { 0x04 }
-sub VALID_SV ()                { 0x08 }
-sub REGISTER ()                { 0x10 } # no implicit write-back when calling subs
-sub TEMPORARY ()       { 0x20 } # no implicit write-back needed at all
-sub SAVE_INT ()        { 0x40 } #if int part needs to be saved at all
-sub SAVE_DOUBLE ()     { 0x80 } #if double part needs to be saved at all
-
-
-#
-# Callback for runtime code generation
-#
-my $runtime_callback = sub { confess "set_callback not yet called" };
-sub set_callback (&) { $runtime_callback = shift }
-sub runtime { &$runtime_callback(@_) }
-
-#
-# Methods
-#
-
-sub write_back { confess "stack object does not implement write_back" }
-
-sub invalidate { shift->{flags} &= ~(VALID_INT |VALID_UNSIGNED | VALID_DOUBLE) }
-
-sub as_sv {
-    my $obj = shift;
-    if (!($obj->{flags} & VALID_SV)) {
-       $obj->write_back;
-       $obj->{flags} |= VALID_SV;
-    }
-    return $obj->{sv};
-}
-
-sub as_int {
-    my $obj = shift;
-    if (!($obj->{flags} & VALID_INT)) {
-       $obj->load_int;
-       $obj->{flags} |= VALID_INT|SAVE_INT;
-    }
-    return $obj->{iv};
-}
-
-sub as_double {
-    my $obj = shift;
-    if (!($obj->{flags} & VALID_DOUBLE)) {
-       $obj->load_double;
-       $obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
-    }
-    return $obj->{nv};
-}
-
-sub as_numeric {
-    my $obj = shift;
-    return $obj->{type} == T_INT ? $obj->as_int : $obj->as_double;
-}
-
-sub as_bool {
-       my $obj=shift;
-       if ($obj->{flags} & VALID_INT ){
-               return $obj->{iv}; 
-       }
-       if ($obj->{flags} & VALID_DOUBLE ){
-               return $obj->{nv}; 
-       }
-       return sprintf("(SvTRUE(%s))", $obj->as_sv) ;
-}
-
-#
-# Debugging methods
-#
-sub peek {
-    my $obj = shift;
-    my $type = $obj->{type};
-    my $flags = $obj->{flags};
-    my @flags;
-    if ($type == T_UNKNOWN) {
-       $type = "T_UNKNOWN";
-    } elsif ($type == T_INT) {
-       $type = "T_INT";
-    } elsif ($type == T_DOUBLE) {
-       $type = "T_DOUBLE";
-    } else {
-       $type = "(illegal type $type)";
-    }
-    push(@flags, "VALID_INT") if $flags & VALID_INT;
-    push(@flags, "VALID_DOUBLE") if $flags & VALID_DOUBLE;
-    push(@flags, "VALID_SV") if $flags & VALID_SV;
-    push(@flags, "REGISTER") if $flags & REGISTER;
-    push(@flags, "TEMPORARY") if $flags & TEMPORARY;
-    @flags = ("none") unless @flags;
-    return sprintf("%s type=$type flags=%s sv=$obj->{sv}",
-                  class($obj), join("|", @flags));
-}
-
-sub minipeek {
-    my $obj = shift;
-    my $type = $obj->{type};
-    my $flags = $obj->{flags};
-    if ($type == T_INT || $flags & VALID_INT) {
-       return $obj->{iv};
-    } elsif ($type == T_DOUBLE || $flags & VALID_DOUBLE) {
-       return $obj->{nv};
-    } else {
-       return $obj->{sv};
-    }
-}
-
-#
-# Caller needs to ensure that set_int, set_double,
-# set_numeric and set_sv are only invoked on legal lvalues.
-#
-sub set_int {
-    my ($obj, $expr,$unsigned) = @_;
-    runtime("$obj->{iv} = $expr;");
-    $obj->{flags} &= ~(VALID_SV | VALID_DOUBLE);
-    $obj->{flags} |= VALID_INT|SAVE_INT;
-    $obj->{flags} |= VALID_UNSIGNED if $unsigned; 
-}
-
-sub set_double {
-    my ($obj, $expr) = @_;
-    runtime("$obj->{nv} = $expr;");
-    $obj->{flags} &= ~(VALID_SV | VALID_INT);
-    $obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
-}
-
-sub set_numeric {
-    my ($obj, $expr) = @_;
-    if ($obj->{type} == T_INT) {
-       $obj->set_int($expr);
-    } else {
-       $obj->set_double($expr);
-    }
-}
-
-sub set_sv {
-    my ($obj, $expr) = @_;
-    runtime("SvSetSV($obj->{sv}, $expr);");
-    $obj->invalidate;
-    $obj->{flags} |= VALID_SV;
-}
-
-#
-# Stackobj::Padsv
-#
-
-@B::Stackobj::Padsv::ISA = 'B::Stackobj';
-sub B::Stackobj::Padsv::new {
-    my ($class, $type, $extra_flags, $ix, $iname, $dname) = @_;
-    $extra_flags |= SAVE_INT if $extra_flags & VALID_INT;
-    $extra_flags |= SAVE_DOUBLE if $extra_flags & VALID_DOUBLE;
-    bless {
-       type => $type,
-       flags => VALID_SV | $extra_flags,
-       sv => "PL_curpad[$ix]",
-       iv => "$iname",
-       nv => "$dname"
-    }, $class;
-}
-
-sub B::Stackobj::Padsv::load_int {
-    my $obj = shift;
-    if ($obj->{flags} & VALID_DOUBLE) {
-       runtime("$obj->{iv} = $obj->{nv};");
-    } else {
-       runtime("$obj->{iv} = SvIV($obj->{sv});");
-    }
-    $obj->{flags} |= VALID_INT|SAVE_INT;
-}
-
-sub B::Stackobj::Padsv::load_double {
-    my $obj = shift;
-    $obj->write_back;
-    runtime("$obj->{nv} = SvNV($obj->{sv});");
-    $obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
-}
-sub B::Stackobj::Padsv::save_int {
-    my $obj = shift;
-    return $obj->{flags} & SAVE_INT;
-}
-
-sub B::Stackobj::Padsv::save_double {
-    my $obj = shift;
-    return $obj->{flags} & SAVE_DOUBLE;
-}
-
-sub B::Stackobj::Padsv::write_back {
-    my $obj = shift;
-    my $flags = $obj->{flags};
-    return if $flags & VALID_SV;
-    if ($flags & VALID_INT) {
-        if ($flags & VALID_UNSIGNED ){
-            runtime("sv_setuv($obj->{sv}, $obj->{iv});");
-        }else{
-            runtime("sv_setiv($obj->{sv}, $obj->{iv});");
-        }     
-    } elsif ($flags & VALID_DOUBLE) {
-       runtime("sv_setnv($obj->{sv}, $obj->{nv});");
-    } else {
-       confess "write_back failed for lexical @{[$obj->peek]}\n";
-    }
-    $obj->{flags} |= VALID_SV;
-}
-
-#
-# Stackobj::Const
-#
-
-@B::Stackobj::Const::ISA = 'B::Stackobj';
-sub B::Stackobj::Const::new {
-    my ($class, $sv) = @_;
-    my $obj = bless {
-       flags => 0,
-       sv => $sv    # holds the SV object until write_back happens
-    }, $class;
-    if ( ref($sv) eq  "B::SPECIAL" ){
-       $obj->{type}= T_SPECIAL;        
-    }else{
-       my $svflags = $sv->FLAGS;
-       if ($svflags & SVf_IOK) {
-               $obj->{flags} = VALID_INT|VALID_DOUBLE;
-               $obj->{type} = T_INT;
-                if ($svflags & SVf_IVisUV){
-                    $obj->{flags} |= VALID_UNSIGNED;
-                    $obj->{nv} = $obj->{iv} = $sv->UVX;
-                }else{
-                    $obj->{nv} = $obj->{iv} = $sv->IV;
-                }
-       } elsif ($svflags & SVf_NOK) {
-               $obj->{flags} = VALID_INT|VALID_DOUBLE;
-               $obj->{type} = T_DOUBLE;
-               $obj->{iv} = $obj->{nv} = $sv->NV;
-       } else {
-               $obj->{type} = T_UNKNOWN;
-       }
-    }
-    return $obj;
-}
-
-sub B::Stackobj::Const::write_back {
-    my $obj = shift;
-    return if $obj->{flags} & VALID_SV;
-    # Save the SV object and replace $obj->{sv} by its C source code name
-    $obj->{sv} = $obj->{sv}->save;
-    $obj->{flags} |= VALID_SV|VALID_INT|VALID_DOUBLE;
-}
-
-sub B::Stackobj::Const::load_int {
-    my $obj = shift;
-    if (ref($obj->{sv}) eq "B::RV"){
-       $obj->{iv} = int($obj->{sv}->RV->PV);
-    }else{
-       $obj->{iv} = int($obj->{sv}->PV);
-    }
-    $obj->{flags} |= VALID_INT;
-}
-
-sub B::Stackobj::Const::load_double {
-    my $obj = shift;
-    if (ref($obj->{sv}) eq "B::RV"){
-        $obj->{nv} = $obj->{sv}->RV->PV + 0.0;
-    }else{
-        $obj->{nv} = $obj->{sv}->PV + 0.0;
-    }
-    $obj->{flags} |= VALID_DOUBLE;
-}
-
-sub B::Stackobj::Const::invalidate {}
-
-#
-# Stackobj::Bool
-#
-
-@B::Stackobj::Bool::ISA = 'B::Stackobj';
-sub B::Stackobj::Bool::new {
-    my ($class, $preg) = @_;
-    my $obj = bless {
-       type => T_INT,
-       flags => VALID_INT|VALID_DOUBLE,
-       iv => $$preg,
-       nv => $$preg,
-       preg => $preg           # this holds our ref to the pseudo-reg
-    }, $class;
-    return $obj;
-}
-
-sub B::Stackobj::Bool::write_back {
-    my $obj = shift;
-    return if $obj->{flags} & VALID_SV;
-    $obj->{sv} = "($obj->{iv} ? &PL_sv_yes : &PL_sv_no)";
-    $obj->{flags} |= VALID_SV;
-}
-
-# XXX Might want to handle as_double/set_double/load_double?
-
-sub B::Stackobj::Bool::invalidate {}
-
-1;
-
-__END__
-
-=head1 NAME
-
-B::Stackobj - Helper module for CC backend
-
-=head1 SYNOPSIS
-
-       use B::Stackobj;
-
-=head1 DESCRIPTION
-
-See F<ext/B/README>.
-
-=head1 AUTHOR
-
-Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
-
-=cut
diff --git a/ext/B/B/Stash.pm b/ext/B/B/Stash.pm
deleted file mode 100644 (file)
index 5e60868..0000000
+++ /dev/null
@@ -1,52 +0,0 @@
-# Stash.pm -- show what stashes are loaded
-# vishalb@hotmail.com 
-package B::Stash;
-
-our $VERSION = '1.00';
-
-=pod
-
-=head1 NAME
-
-B::Stash - show what stashes are loaded
-
-=cut
-
-BEGIN { %Seen = %INC }
-
-CHECK {
-       my @arr=scan($main::{"main::"});
-       @arr=map{s/\:\:$//;$_ eq "<none>"?():$_;}  @arr;
-       print "-umain,-u", join (",-u",@arr) ,"\n";
-}
-sub scan{
-       my $start=shift;
-       my $prefix=shift;
-       $prefix = '' unless defined $prefix;
-       my @return;
-       foreach my $key ( keys %{$start}){
-#              print $prefix,$key,"\n";
-               if ($key =~ /::$/){
-                       unless ($start  eq ${$start}{$key} or $key eq "B::" ){
-                               push @return, $key unless omit($prefix.$key);
-                               foreach my $subscan ( scan(${$start}{$key},$prefix.$key)){
-                                       push @return, "$key".$subscan;  
-                               }
-                       }
-               }
-       }
-       return @return;
-}
-sub omit{
-       my $module = shift;
-       my %omit=("DynaLoader::" => 1 , "XSLoader::" => 1, "CORE::" => 1 ,
-               "CORE::GLOBAL::" => 1, "UNIVERSAL::" => 1 );
-       return 1 if $omit{$module};
-       if ($module eq "IO::" or $module eq "IO::Handle::"){
-               $module =~ s/::/\//g;   
-               return 1 unless  $INC{$module};
-       }
-
-       return 0;
-}
-1;
diff --git a/ext/B/B/assemble b/ext/B/B/assemble
deleted file mode 100755 (executable)
index 43cc5bc..0000000
+++ /dev/null
@@ -1,30 +0,0 @@
-use B::Assembler qw(assemble_fh);
-use FileHandle;
-
-my ($filename, $fh, $out);
-
-if ($ARGV[0] eq "-d") {
-    B::Assembler::debug(1);
-    shift;
-}
-
-$out = \*STDOUT;
-
-if (@ARGV == 0) {
-    $fh = \*STDIN;
-    $filename = "-";
-} elsif (@ARGV == 1) {
-    $filename = $ARGV[0];
-    $fh = new FileHandle "<$filename";
-} elsif (@ARGV == 2) {
-    $filename = $ARGV[0];
-    $fh = new FileHandle "<$filename";
-    $out = new FileHandle ">$ARGV[1]";
-} else {
-    die "Usage: assemble [filename] [outfilename]\n";
-}
-
-binmode $out;
-$SIG{__WARN__} = sub { warn "$filename:@_" };
-$SIG{__DIE__} = sub { die "$filename: @_" };
-assemble_fh($fh, sub { print $out @_ });
diff --git a/ext/B/B/cc_harness b/ext/B/B/cc_harness
deleted file mode 100644 (file)
index 79f8727..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-use Config;
-
-$libdir = $ENV{PERL_SRC} || "$Config{installarchlib}/CORE";
-
-if (!grep(/^-[cS]$/, @ARGV)) {
-    $linkargs = sprintf("%s $libdir/$Config{libperl} %s",
-                       @Config{qw(ldflags libs)});
-}
-
-$cccmd = "$Config{cc} $Config{ccflags} -I$libdir @ARGV $linkargs";
-print "$cccmd\n";
-exec $cccmd;
diff --git a/ext/B/B/disassemble b/ext/B/B/disassemble
deleted file mode 100755 (executable)
index 6530b80..0000000
+++ /dev/null
@@ -1,22 +0,0 @@
-use B::Disassembler qw(disassemble_fh);
-use FileHandle;
-
-my $fh;
-if (@ARGV == 0) {
-    $fh = \*STDIN;
-} elsif (@ARGV == 1) {
-    $fh = new FileHandle "<$ARGV[0]";
-} else {
-    die "Usage: disassemble [filename]\n";
-}
-
-sub print_insn {
-    my ($insn, $arg) = @_;
-    if (defined($arg)) {
-       printf "%s %s\n", $insn, $arg;
-    } else {
-       print $insn, "\n";
-    }
-}
-
-disassemble_fh($fh, \&print_insn);
diff --git a/ext/B/B/makeliblinks b/ext/B/B/makeliblinks
deleted file mode 100644 (file)
index 8256078..0000000
+++ /dev/null
@@ -1,54 +0,0 @@
-use File::Find;
-use Config;
-
-if (@ARGV != 2) {
-    warn <<"EOT";
-Usage: makeliblinks libautodir targetdir
-where libautodir is the architecture-dependent auto directory
-(e.g. $Config::Config{archlib}/auto).
-EOT
-    exit 2;
-}
-
-my ($libautodir, $targetdir) = @ARGV;
-
-# Calculate relative path prefix from $targetdir to $libautodir
-sub relprefix {
-    my ($to, $from) = @_;
-    my $up;
-    for ($up = 0; substr($to, 0, length($from)) ne $from; $up++) {
-       $from =~ s(
-                  [^/]+        (?# a group of non-slashes) 
-                  /*           (?# maybe with some trailing slashes)
-                  $            (?# at the end of the path)
-                  )()x;
-    }
-    return (("../" x $up) . substr($to, length($from)));
-}
-
-my $relprefix = relprefix($libautodir, $targetdir);
-
-my ($dlext, $lib_ext) = @Config::Config{qw(dlext lib_ext)};
-
-sub link_if_library {
-    if (/\.($dlext|$lib_ext)$/o) {
-       my $ext = $1;
-       my $name = $File::Find::name;
-       if (substr($name, 0, length($libautodir) + 1) ne "$libautodir/") {
-           die "directory of $name doesn't match $libautodir\n";
-       }
-       substr($name, 0, length($libautodir) + 1) = '';
-       my @parts = split(m(/), $name);
-       if ($parts[-1] ne "$parts[-2].$ext") {
-           die "module name $_ doesn't match its directory $libautodir\n";
-       }
-       pop @parts;
-       my $libpath = "$targetdir/lib" . join("__", @parts) . ".$ext";
-       print "$libpath -> $relprefix/$name\n";
-       symlink("$relprefix/$name", $libpath)
-           or warn "above link failed with error: $!\n";
-    }
-}
-
-find(\&link_if_library, $libautodir);
-exit 0;
diff --git a/ext/B/C/C.xs b/ext/B/C/C.xs
deleted file mode 100644 (file)
index b7fb7fa..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-#include <EXTERN.h>
-#include <perl.h>
-#include <XSUB.h>
-
-static int
-my_runops(pTHX)
-{
-    HV* regexp_hv = get_hv( "B::C::REGEXP", 0 );
-    SV* key = newSViv( 0 );
-
-    do {
-       PERL_ASYNC_CHECK();
-
-        if( PL_op->op_type == OP_QR ) {
-            PMOP* op;
-            REGEXP* rx = PM_GETRE( (PMOP*)PL_op );
-            SV* rv = newSViv( 0 );
-
-            Newx( op, 1, PMOP );
-            Copy( PL_op, op, 1, PMOP );
-            /* we need just the flags */
-            op->op_next = NULL;
-            op->op_sibling = NULL;
-            op->op_first = NULL;
-            op->op_last = NULL;
-            op->op_pmreplroot = NULL;
-            op->op_pmreplstart = NULL;
-            op->op_pmnext = NULL;
-#ifdef USE_ITHREADS
-            op->op_pmoffset = 0;
-#else
-            op->op_pmregexp = 0;
-#endif
-
-            sv_setiv( key, PTR2IV( rx ) );
-            sv_setref_iv( rv, "B::PMOP", PTR2IV( op ) );
-
-            hv_store_ent( regexp_hv, key, rv, 0 );
-        }
-    } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
-
-    SvREFCNT_dec( key );
-
-    TAINT_NOT;
-    return 0;
-}
-
-MODULE=B__C PACKAGE=B::C
-
-PROTOTYPES: DISABLE
-
-BOOT:
-    PL_runops = my_runops;
diff --git a/ext/B/C/Makefile.PL b/ext/B/C/Makefile.PL
deleted file mode 100644 (file)
index 7291b33..0000000
+++ /dev/null
@@ -1,8 +0,0 @@
-#!perl
-
-use ExtUtils::MakeMaker;
-
-WriteMakefile( NAME => 'B::C',
-               VERSION_FROM => '../B/C.pm'
-             );
-
diff --git a/ext/B/NOTES b/ext/B/NOTES
deleted file mode 100644 (file)
index 89d03ba..0000000
+++ /dev/null
@@ -1,168 +0,0 @@
-C backend invocation
-       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.
-       -ofilename      Output to filename instead of STDOUT
-       -v              Verbose (currently gives a few compilation statistics)
-       --              Force end of options
-       -uPackname      Force apparently unused subs from package Packname to
-                       be compiled. This allows programs to use eval "foo()"
-                       even when sub foo is never seen to be used at compile
-                       time. The down side is that any subs which really are
-                       never used also have code generated. This option is
-                       necessary, for example, if you have a signal handler
-                       foo which you initialise with $SIG{BAR} = "foo".
-                       A better fix, though, is just to change it to
-                       $SIG{BAR} = \&foo. You can have multiple -u options.
-       -D              Debug options (concat or separate flags like perl -D)
-               o       OPs, prints each OP as it's processed
-               c       COPs, prints COPs as processed (incl. file & line num)
-               A       prints AV information on saving
-               C       prints CV information on saving
-               M       prints MAGIC information on saving
-       -f              Force optimisations on or off one at a time.
-               cog     Copy-on-grow: PVs declared and initialised statically
-               no-cog  No copy-on-grow
-       -On             Optimisation level (n = 0, 1, 2, ...). -O means -O1.
-                       Currently, -O1 and higher set -fcog.
-
-Examples
-       perl -MO=C foo.pl > foo.c
-       perl cc_harness -o foo foo.c
-
-       perl -MO=C,-v,-DcA bar.pl > /dev/null
-
-CC backend invocation
-       If there are any non-option arguments, they are taken to be names of
-       subs to be saved. Without extra arguments, it saves the main program.
-       -ofilename      Output to filename instead of STDOUT
-       --              Force end of options
-       -uPackname      Force apparently unused subs from package Packname to
-                       be compiled. This allows programs to use eval "foo()"
-                       even when sub foo is never seen to be used at compile
-                       time. The down side is that any subs which really are
-                       never used also have code generated. This option is
-                       necessary, for example, if you have a signal handler
-                       foo which you initialise with $SIG{BAR} = "foo".
-                       A better fix, though, is just to change it to
-                       $SIG{BAR} = \&foo. You can have multiple -u options.
-       -mModulename    Instead of generating source for a runnable executable,
-                       generate source for an XSUB module. The
-                       boot_Modulename function (which DynaLoader can look
-                       for) does the appropriate initialisation and runs the
-                       main part of the Perl source that is being compiled.
-       -pn             Generate code for perl patchlevel n (e.g. 3 or 4).
-                       The default is to generate C code which will link
-                       with the currently executing version of perl.
-                       running the perl compiler.
-       -D              Debug options (concat or separate flags like perl -D)
-               r       Writes debugging output to STDERR just as it's about
-                       to write to the program's runtime (otherwise writes
-                       debugging info as comments in its C output).
-               O       Outputs each OP as it's compiled
-               s       Outputs the contents of the shadow stack at each OP
-               p       Outputs the contents of the shadow pad of lexicals as
-                       it's loaded for each sub or the main program.
-               q       Outputs the name of each fake PP function in the queue
-                       as it's about to processes.
-               l       Output the filename and line number of each original
-                       line of Perl code as it's processed (pp_nextstate).
-               t       Outputs timing information of compilation stages
-       -f              Force optimisations on or off one at a time.
-               [
-               cog     Copy-on-grow: PVs declared and initialised statically
-               no-cog  No copy-on-grow
-               These two not in CC yet.
-               ]
-               freetmps-each-bblock    Delays FREETMPS from the end of each
-                                       statement to the end of the each basic
-                                       block.
-               freetmps-each-loop      Delays FREETMPS from the end of each
-                                       statement to the end of the group of
-                                       basic blocks forming a loop. At most
-                                       one of the freetmps-each-* options can
-                                       be used.
-               omit-taint              Omits generating code for handling
-                                       perl's tainting mechanism.
-       -On             Optimisation level (n = 0, 1, 2, ...). -O means -O1.
-                       Currently, -O1 sets -ffreetmps-each-bblock and -O2
-                       sets -ffreetmps-each-loop.
-
-Example
-       perl -MO=CC,-O2,-ofoo.c foo.pl
-       perl cc_harness -o foo foo.c
-
-       perl -MO=CC,-mFoo,-oFoo.c Foo.pm
-       perl cc_harness -shared -c -o Foo.so Foo.c
-
-
-Bytecode backend invocation
-
-       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.
-       -ofilename      Output to filename instead of STDOUT.
-       --              Force end of options.
-       -f              Force optimisations on or off one at a time.
-                       Each can be preceded by no- to turn the option off.
-               compress-nullops
-                       Only fills in the necessary fields of ops which have
-                       been optimised away by perl's internal compiler.
-               omit-sequence-numbers
-                       Leaves out code to fill in the op_seq field of all ops
-                       which is only used by perl's internal compiler.
-               bypass-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.
-               strip-syntax-tree
-                       Leaves out code to fill in the pointers which link the
-                       internal syntax tree together. They're not needed at
-                       run-time but leaving them out will make it impossible
-                       to recompile or disassemble the resulting program.
-                       It will also stop "goto label" statements from working.
-       -On             Optimisation level (n = 0, 1, 2, ...). -O means -O1.
-                       -O1 sets -fcompress-nullops -fomit-sequence numbers.
-                       -O6 adds -fstrip-syntax-tree.
-       -D              Debug options (concat or separate flags like perl -D)
-               o       OPs, prints each OP as it's processed.
-               b       print debugging information about bytecompiler progress
-               a       tells the assembler to include source assembler lines
-                       in its output as bytecode comments.
-               C       prints each CV taken from the final symbol tree walk.
-       -S              Output assembler source rather than piping it
-                       through the assembler and outputting bytecode.
-       -m              Compile as a module rather than a standalone program.
-                       Currently this just means that the bytecodes for
-                       initialising main_start, main_root and curpad are
-                       omitted.
-
-Example
-       perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
-
-       perl -MO=Bytecode,-S foo.pl > foo.S
-       assemble foo.S > foo.plc
-       byteperl foo.plc
-
-       perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm
-
-Backends for debugging
-       perl -MO=Terse,exec foo.pl
-       perl -MO=Debug bar.pl
-
-O module
-       Used with "perl -MO=Backend,foo,bar prog.pl" to invoke the backend
-       B::Backend with options foo and bar. O invokes the sub
-       B::Backend::compile() with arguments foo and bar at BEGIN time.
-       That compile() sub must do any inital argument processing replied.
-       If unsuccessful, it should return a string which O arranges to be
-       printed as an error message followed by a clean error exit. In the
-       normal case where any option processing in compile() is successful,
-       it should return a sub ref (usually a closure) to perform the
-       actual compilation. When O regains control, it ensures that the
-       "-c" option is forced (so that the program being compiled doesn't
-       end up running) and registers a CHECK block to call back the sub ref
-       returned from the backend's compile(). Perl then continues by
-       parsing prog.pl (just as it would with "perl -c prog.pl") and after
-       doing so, assuming there are no parse-time errors, the CHECK block
-       of O gets called and the actual backend compilation happens. Phew.
diff --git a/ext/B/README b/ext/B/README
deleted file mode 100644 (file)
index fa3f085..0000000
+++ /dev/null
@@ -1,325 +0,0 @@
-                 Perl Compiler Kit, Version alpha4
-
-                Copyright (c) 1996, 1997, Malcolm Beattie
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of either:
-
-       a) the GNU General Public License as published by the Free
-       Software Foundation; either version 1, or (at your option) any
-       later version, or
-
-       b) the "Artistic License" which comes with this kit.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
-    the GNU General Public License or the Artistic License for more details.
-
-    You should have received a copy of the Artistic License with this kit,
-    in the file named "Artistic".  If not, you can get one from the Perl
-    distribution. You should also have received a copy of the GNU General
-    Public License, in the file named "Copying". If not, you can get one
-    from the Perl distribution or else write to the Free Software Foundation,
-    Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
-
-CHANGES
-
-New since alpha3
-    Anonymous subs work properly with C and CC.
-    Heuristics for forcing compilation of apparently unused subs/methods.
-    Subs which use the AutoLoader module are forcibly loaded at compile-time.
-    Slightly faster compilation.
-    Handles slightly more complex code within a BEGIN { }.
-    Minor bug fixes.
-
-New since alpha2
-    CC backend now supports ".." and s//e.
-    Xref backend generates cross-reference reports
-    Cleanups to fix benign but irritating "-w" warnings
-    Minor cxstack fix
-New since alpha1
-    Working CC backend
-    Shared globs and pre-initialised hash support
-    Some XSUB support
-    Assorted bug fixes
-
-INSTALLATION
-
-(1) You need perl5.002 or later.
-
-(2) If you want to compile and run programs with the C or CC backends
-which undefine (or redefine) subroutines, then you need to apply a
-one-line patch to perl itself. One or two of the programs in perl's
-own test suite do this. The patch is in file op.patch. It prevents
-perl from calling free() on OPs with the magic sequence number (U16)-1.
-The compiler declares all OPs as static structures and uses that magic
-sequence number.
-
-(3) Type
-    perl Makefile.PL
-to write a personalised Makefile for your system. If you want the
-bytecode modules to support reading bytecode from strings (instead of
-just from files) then add the option
-    -DINDIRECT_BGET_MACROS
-into the middle of the definition of the CCCMD macro in the Makefile.
-Your C compiler may need to be able to cope with Standard C for this.
-I haven't tested this option yet with an old pre-Standard compiler.
-
-(4) If your platform supports dynamic loading then just type
-    make
-and you can then use
-    perl -Iblib/arch -MO=foo bar
-to use the compiler modules (see later for details).
-If you need/want instead to make a statically linked perl which
-contains the appropriate modules, then type
-    make perl
-    make byteperl
-and you can then use
-    ./perl -MO=foo bar
-to use the compiler modules.    
-In both cases, the byteperl executable is required for running standalone
-bytecode programs. It is *not* a standard perl+XSUB perl executable.
-
-USAGE
-
-As of the alpha3 release, the Bytecode, C and CC backends are now all
-functional enough to compile almost the whole of the main perl test
-suite. In the case of the CC backend, any failures are all due to
-differences and/or known bugs documented below. See the file TESTS.
-In the following examples, you'll need to replace "perl" by
-    perl -Iblib/arch
-if you have built the extensions for a dynamic loading platform but
-haven't installed the extensions completely. You'll need to replace
-"perl" by
-    ./perl
-if you have built the extensions into a statically linked perl binary.
-
-(1) To compile perl program foo.pl with the C backend, do
-    perl -MO=C,-ofoo.c foo.pl
-Then use the cc_harness perl program to compile the resulting C source:
-    perl cc_harness -O2 -o foo foo.c
-
-If you are using a non-ANSI pre-Standard C compiler that can't handle
-pre-declaring static arrays, then add -DBROKEN_STATIC_REDECL to the
-options you use:
-    perl cc_harness -O2 -o foo -DBROKEN_STATIC_REDECL foo.c
-If you are using a non-ANSI pre-Standard C compiler that can't handle
-static initialisation of structures with union members then add
--DBROKEN_UNION_INIT to the options you use. If you want command line
-arguments passed to your executable to be interpreted by perl (e.g. -Dx)
-then compile foo.c with -DALLOW_PERL_OPTIONS. Otherwise, all command line
-arguments passed to foo will appear directly in @ARGV.  The resulting
-executable foo is the compiled version of foo.pl. See the file NOTES for
-extra options you can pass to -MO=C.
-
-There are some constraints on the contents on foo.pl if you want to be
-able to compile it successfully. Some problems can be fixed fairly easily
-by altering foo.pl; some problems with the compiler are known to be
-straightforward to solve and I'll do so soon. The file Todo lists a
-number of known problems. See the XSUB section lower down for information
-about compiling programs which use XSUBs.
-
-(2) To compile foo.pl with the CC backend (which generates actual
-optimised C code for the execution path of your perl program), use
-    perl -MO=CC,-ofoo.c foo.pl
-
-and proceed just as with the C backend. You should almost certainly
-use an option such as -O2 with the subsequent cc_harness invocation
-so that your C compiler uses optimisation. The C code generated by
-the Perl compiler's CC backend looks ugly to humans but is easily
-optimised by C compilers.
-
-To make the most of this compiler backend, you need to tell the
-compiler when you're using int or double variables so that it can
-optimise appropriately (although this part of the compiler is the most
-buggy). You currently do that by naming lexical variables ending in
-"_i" for ints, "_d" for doubles, "_ir" for int "register" variables or
-"_dr" for double "register" variables. Here "register" is a promise
-that you won't pass a reference to the variable into a sub which then
-modifies the variable. The compiler ought to catch attempts to use
-"\$i" just as C compilers catch attempts to do "&i" for a register int
-i but it doesn't at the moment. Bugs in the CC backend may make your
-program fail in mysterious ways and give wrong answers rather than just
-crash in boring ways. But, hey, this is an alpha release so you knew
-that anyway. See the XSUB section lower down for information about
-compiling programs which use XSUBs.
-
-If your program uses classes which define methods (or other subs which
-are not exported and not apparently used until runtime) then you'll
-need to use -u compile-time options (see the NOTES file) to force the
-subs to be compiled. Future releases will probably default the other
-way, do more auto-detection and provide more fine-grained control.
-
-Since compiled executables need linking with libperl, you may want
-to turn libperl.a into a shared library if your platform supports
-it. For example, with Digital UNIX, do something like
-    ld -shared -o libperl.so -all libperl.a -none -lc
-and with Linux/ELF, rebuild the perl .c files with -fPIC (and I
-also suggest -fomit-frame-pointer for Linux on Intel architetcures),
-do "make libperl.a" and then do
-    gcc -shared -Wl,-soname,libperl.so.5 -o libperl.so.5.3 `ar t libperl.a`
-and then
-    # cp libperl.so.5.3 /usr/lib
-    # cd /usr/lib
-    # ln -s libperl.so.5.3 libperl.so.5
-    # ln -s libperl.so.5 libperl.so
-    # ldconfig
-When you compile perl executables with cc_harness, append -L/usr/lib
-otherwise the -L for the perl source directory will override it. For
-example,
-    perl -Iblib/arch -MO=CC,-O2,-ofoo3.c foo3.bench
-    perl cc_harness -o foo3 -O2 foo3.c -L/usr/lib
-    ls -l foo3
-    -rwxr-xr-x   1 mbeattie xzdg        11218 Jul  1 15:28 foo3
-You'll probably also want to link your main perl executable against
-libperl.so; it's nice having an 11K perl executable.
-
-(3) To compile foo.pl into bytecode do
-    perl -MO=Bytecode,-ofoo foo.pl
-To run the resulting bytecode file foo as a standalone program, you
-use the program byteperl which should have been built along with the
-extensions.
-    ./byteperl foo
-Any extra arguments are passed in as @ARGV; they are not interpreted
-as perl options. If you want to load chunks of bytecode into an already
-running perl program then use the -m option and investigate the
-byteload_fh and byteload_string functions exported by the B module.
-See the NOTES file for details of these and other options (including
-optimisation options and ways of getting at the intermediate "assembler"
-code that the Bytecode backend uses).
-
-(3) There are little Bourne shell scripts and perl programs to aid with
-some common operations: assemble, disassemble, run_bytecode_test,
-run_test, cc_harness, test_harness, test_harness_bytecode.
-
-(4) Walk the op tree in execution order printing terse info about each op
-    perl -MO=Terse,exec foo.pl
-
-(5) Walk the op tree in syntax order printing lengthier debug info about
-each op. You can also append ",exec" to walk in execution order, but the
-formatting is designed to look nice with Terse rather than Debug.
-    perl -MO=Debug foo.pl
-
-(6) Produce a cross-reference report of the line numbers at which all
-variables, subs and formats are defined and used.
-    perl -MO=Xref foo.pl
-
-XSUBS
-
-The C and CC backends can successfully compile some perl programs which
-make use of XSUB extensions. [I'll add more detail to this section in a
-later release.] As a prerequisite, such extensions must not need to do
-anything in their BOOT: section which needs to be done at runtime rather
-than compile time. Normally, the only code in the boot_Foo() function is
-a list of newXS() calls which xsubpp puts there and the compiler handles
-saving those XS subs itself. For each XSUB used, the C and CC compiler
-will generate an initialiser in their C output which refers to the name
-of the relevant C function (XS_Foo_somesub). What is not yet automated
-is the necessary commands and cc command-line options (e.g. via
-"perl cc_harness") which link against the extension libraries. For now,
-you need the XSUB extension to have installed files in the right format
-for using as C libraries (e.g. Foo.a or Foo.so). As the Foo.so files (or
-your platform's version) aren't suitable for linking against, you will
-have to reget the extension source and rebuild it as a static extension
-to force the generation of a suitable Foo.a file. Then you need to make
-a symlink (or copy or rename) of that file into a libFoo.a suitable for
-cc linking. Then add the appropriate -L and -l options to your
-"perl cc_harness" command line to find and link against those libraries.
-You may also need to fix up some platform-dependent environment variable
-to ensure that linked-against .so files are found at runtime too.
-
-DIFFERENCES
-
-The result of running a compiled Perl program can sometimes be different
-from running the same program with standard perl. Think of the compiler
-as having a slightly different implementation of the language Perl.
-Unfortunately, since Perl has had a single implementation until now,
-there are no formal standards or documents defining what behaviour is
-guaranteed of Perl the language and what just "happens to work".
-Some of the differences below are almost impossible to change because of
-the way the compiler works. Others can be changed to produce "standard"
-perl behaviour if it's deemed proper and the resulting performance hit
-is accepted. I'll use "standard perl" to mean the result of running a
-Perl program using the perl executable from the perl distribution.
-I'll use "compiled Perl program" to mean running an executable produced
-by this compiler kit ("the compiler") with the CC backend.
-
-Loops
-    Standard perl calculates the target of "next", "last", and "redo"
-    at run-time. The compiler calculates the targets at compile-time.
-    For example, the program
-
-        sub skip_on_odd { next NUMBER if $_[0] % 2 }
-        NUMBER: for ($i = 0; $i < 5; $i++) {
-            skip_on_odd($i);
-            print $i;
-        }
-
-    produces the output
-        024
-    with standard perl but gives a compile-time error with the compiler.
-
-Context of ".."
-    The context (scalar or array) of the ".." operator determines whether
-    it behaves as a range or a flip/flop. Standard perl delays until
-    runtime the decision of which context it is in but the compiler needs
-    to know the context at compile-time. For example,
-       @a = (4,6,1,0,0,1);
-       sub range { (shift @a)..(shift @a) }
-       print range();
-       while (@a) { print scalar(range()) }
-    generates the output
-        456123E0
-    with standard Perl but gives a compile-time error with compiled Perl.
-
-Arithmetic
-    Compiled Perl programs use native C arithemtic much more frequently
-    than standard perl. Operations on large numbers or on boundary
-    cases may produce different behaviour.
-
-Deprecated features
-    Features of standard perl such as $[ which have been deprecated
-    in standard perl since version 5 was released have not been
-    implemented in the compiler.
-
-Others
-    I'll add to this list as I remember what they are.
-
-BUGS
-
-Here are some things which may cause the compiler problems.
-
-The following render the compiler useless (without serious hacking):
-* Use of the DATA filehandle (via __END__ or __DATA__ tokens)
-* Operator overloading with %OVERLOAD
-* The (deprecated) magic array-offset variable $[ does not work
-* The following operators are not yet implemented for CC
-    goto
-    sort with a non-default comparison (i.e. a named sub or inline block)
-* You can't use "last" to exit from a non-loop block.
-
-The following may give significant problems:
-* BEGIN blocks containing complex initialisation code
-* Code which is only ever referred to at runtime (e.g. via eval "..." or
-  via method calls): see the -u option for the C and CC backends.
-* Run-time lookups of lexical variables in "outside" closures
-
-The following may cause problems (not thoroughly tested):
-* Dependencies on whether values of some "magic" Perl variables are
-  determined at compile-time or runtime.
-* For the C and CC backends: compile-time strings which are longer than
-  your C compiler can cope with in a single line or definition.
-* Reliance on intimate details of global destruction
-* For the Bytecode backend: high -On optimisation numbers with code
-  that has complex flow of control.
-* Any "-w" option in the first line of your perl program is seen and
-  acted on by perl itself before the compiler starts. The compiler
-  itself then runs with warnings turned on. This may cause perl to
-  print out warnings about the compiler itself since I haven't tested
-  it thoroughly with warnings turned on.
-
-There is a terser but more complete list in the Todo file.
-
-Malcolm Beattie
-2 September 1996
diff --git a/ext/B/TESTS b/ext/B/TESTS
deleted file mode 100644 (file)
index e050f6c..0000000
+++ /dev/null
@@ -1,78 +0,0 @@
-Test results from compiling t/*/*.t
-               C               Bytecode        CC
-
-base/cond.t    OK              ok              OK
-base/if.t      OK              ok              OK
-base/lex.t     OK              ok              OK
-base/pat.t     OK              ok              OK
-base/term.t    OK              ok              OK
-cmd/elsif.t    OK              ok              OK
-cmd/for.t      OK              ok              ok 1, 2, 3, panic: pp_iter
-cmd/mod.t      OK              ok              ok
-cmd/subval.t   OK              ok              1..34, not ok 27,28 (simply
-                                               because filename changes).
-cmd/switch.t   OK              ok              ok
-cmd/while.t    OK              ok              ok
-io/argv.t      OK              ok              ok
-io/dup.t       OK              ok              ok
-io/fs.t                OK              ok              ok
-io/inplace.t   OK              ok              ok
-io/pipe.t      OK              ok              ok with -umain
-io/print.t     OK              ok              ok
-io/tell.t      OK              ok              ok
-op/append.t    OK              ok              OK
-op/array.t     OK              ok              1..36, not ok 7,10 (no $[)
-op/auto.t      OK              ok              OK
-op/chop.t      OK              ok              OK
-op/cond.t      OK              ok              OK
-op/delete.t    OK              ok              OK
-op/do.t                OK              ok              OK
-op/each.t      OK              ok              OK
-op/eval.t      OK              ok              ok 1-6 of 16 then exits
-op/exec.t      OK              ok              OK
-op/exp.t       OK              ok              OK
-op/flip.t      OK              ok              OK
-op/fork.t      OK              ok              OK
-op/glob.t      OK              ok              OK
-op/goto.t      OK              ok              1..9, Can't find label label1.
-op/groups.t    OK (s/ucb/bin/ under Linux)     OK 1..0 for now.
-op/index.t     OK              ok              OK
-op/int.t       OK              ok              OK
-op/join.t      OK              ok              OK
-op/list.t      OK              ok              OK
-op/local.t     OK              ok              OK
-op/magic.t     OK              ok              OK
-op/misc.t      no DATA filehandle so succeeds trivially with 1..0
-op/mkdir.t     OK              ok              OK
-op/my.t                OK              ok              OK
-op/oct.t       OK              ok              OK (C large const warnings)
-op/ord.t       OK              ok              OK
-op/overload.t  Mostly not ok   Mostly not ok   C errors.
-op/pack.t      OK              ok              OK
-op/pat.t       omit 26 (reset) ok              [lots of memory for compile]
-op/push.t      OK              ok              OK
-op/quotemeta.t OK              ok              OK
-op/rand.t      OK              ok              
-op/range.t     OK              ok              OK
-op/read.t      OK              ok              OK
-op/readdir.t   OK              ok              OK (substcont works too)
-op/ref.t       omits "ok 40" (lex destruction) ok (Bytecode)
-                                               CC: need -u for OBJ,BASEOBJ,
-                                               UNIVERSAL,WHATEVER,main.
-                                               1..41, ok1-33,36-38,
-                                               then ok 41, ok 39.DESTROY probs
-op/regexp.t    OK              ok              ok (trivially all eval'd)
-op/repeat.t    OK              ok              ok
-op/sleep.t     OK              ok              ok
-op/sort.t      OK              ok              1..10, ok 1, Out of memory!
-op/split.t     OK              ok              ok
-op/sprintf.t   OK              ok              ok
-op/stat.t      OK              ok              ok
-op/study.t     OK              ok              ok
-op/subst.t     OK              ok              ok
-op/substr.t    OK              ok              ok1-22 except 7-9,11 (all $[)
-op/time.t      OK              ok              ok
-op/undef.t     omit 21         ok              ok
-op/unshift.t   OK              ok              ok
-op/vec.t       OK              ok              ok
-op/write.t     not ok 3 (no CvOUTSIDE lex from runtime eval). CC: 1..3, hang
diff --git a/ext/B/Todo b/ext/B/Todo
deleted file mode 100644 (file)
index 495be2e..0000000
+++ /dev/null
@@ -1,37 +0,0 @@
-* Fixes
-
-CC backend: goto, sort with non-default comparison. last for non-loop blocks.
-Version checking
-improve XSUB handling (both static and dynamic)
-sv_magic can do SvREFCNT_inc(obj) which messes up precalculated refcounts
-allocation of XPV[INAHC]V structures needs fixing: Perl tries to free
-them whereas the compiler expects them to be linked to a xpv[inahc]v_root
-list the same as X[IPR]V structures.
-ref counts
-perl_parse replacement
-fix cstring for long strings
-compile-time initialisation of AvARRAYs
-signed/unsigned problems with NV (and IV?) initialisation and elsewhere?
-CvOUTSIDE for ordinary subs
-DATA filehandle for standalone Bytecode program (easy)
-DATA filehandle for multiple bytecode-compiled modules (harder)
-DATA filehandle for C-compiled program (yet harder)
-
-* Features
-
-type checking
-compile time v. runtime initialisation
-save PMOPs in compiled form
-selection of what to dump
-options for cutting out line info etc.
-comment output
-shared constants
-module dependencies
-
-* Optimisations
-collapse LISTOPs to UNOPs or BASEOPs
-compile-time qw(), constant subs
-global analysis of variables, type hints etc.
-demand-loaded bytecode (leader of each basic block replaced by an op
-which loads in bytecode for its block)
-fast sub calls for CC backend
diff --git a/ext/B/ramblings/cc.notes b/ext/B/ramblings/cc.notes
deleted file mode 100644 (file)
index 47bd65a..0000000
+++ /dev/null
@@ -1,32 +0,0 @@
-At entry to each basic block, the following can be assumed (and hence
-must be forced where necessary at the end of each basic block):
-
-The shadow stack @stack is empty.
-For each lexical object in @pad, VALID_IV holds for each T_INT,
-VALID_DOUBLE holds for each T_DOUBLE and VALID_SV holds otherwise.
-The C shadow variable sp holds the stack pointer (not necessarily stack_sp).
-
-write_back_stack
-    Writes the contents of the shadow stack @stack back to the real stack.
-    A write-back of each object in the stack is forced so that its
-    backing SV contains the right value and that SV is then pushed onto the
-    real stack. On return, @stack is empty.
-
-write_back_lexicals
-    Forces a write-back (i.e. achieves VALID_SV), where necessary, for each
-    lexical object in @pad. Objects with the TEMPORARY flag are skipped. If
-    write_back_lexicals is called with an (optional) argument, then it is
-    taken to be a bitmask of more flags: any lexical object with one of those
-    flags set is also skipped and not written back to its SV.
-
-invalidate_lexicals($avoid)
-    The VALID_INT and VALID_DOUBLE flags are turned off for each lexical
-    object in @pad whose flags field doesn't overlap with $avoid.
-
-reload_lexicals
-    For each necessary lexical object in @pad, makes sure that VALID_IV
-    holds for objects of type T_INT, VALID_DOUBLE holds for objects for
-    type T_DOUBLE, and VALID_SV holds for other objects. An object is
-    considered for reloading if its flags field does not overlap with the
-    (optional) argument passed to reload_lexicals.
-
diff --git a/ext/B/ramblings/curcop.runtime b/ext/B/ramblings/curcop.runtime
deleted file mode 100644 (file)
index 9b8b7d5..0000000
+++ /dev/null
@@ -1,39 +0,0 @@
-PP code uses of curcop
-----------------------
-
-pp_rv2gv
-       when a new glob is created for an OPpLVAL_INTRO,
-       curcop->cop_line is stored as GvLINE() in the new GP.
-pp_bless
-       curcop->cop_stash is used as the stash in the one-arg form of bless
-
-pp_repeat
-       tests (curcop != &compiling) to warn "Can't x= to readonly value"
-
-pp_pos
-pp_substr
-pp_index
-pp_rindex
-pp_aslice
-pp_lslice
-pp_splice
-       curcop->cop_arybase
-
-pp_sort
-       curcop->cop_stash used to determine whether to gv_fetchpv $a and $b
-
-pp_caller
-       tests (curcop->cop_stash == debstash) to determine whether
-       to set DB::args
-
-pp_reset
-       resets vars in curcop->cop_stash
-
-pp_dbstate
-       sets curcop = (COP*)op
-
-doeval
-       compiles into curcop->cop_stash
-
-pp_nextstate
-       sets curcop = (COP*)op
diff --git a/ext/B/ramblings/flip-flop b/ext/B/ramblings/flip-flop
deleted file mode 100644 (file)
index e08333d..0000000
+++ /dev/null
@@ -1,54 +0,0 @@
-PP(pp_range)
-{
-    if (GIMME == G_ARRAY)
-        return NORMAL;
-    if (SvTRUEx(PAD_SV(PL_op->op_targ)))
-       return cLOGOP->op_other;
-    else
-       return NORMAL;
-}
-
-pp_range is a LOGOP.
-In list context, it just returns op_next.
-In scalar context it checks the truth of targ and returns
-op_other if true, op_next if false.
-
-flip is an UNOP.
-It "looks after" its child which is always a pp_range LOGOP.
-In list context, it just returns the child's op_other.
-In scalar context, there are three possible outcomes:
-  (1) set child's targ to 1, our targ to 1 and return op_next.
-  (2) set child's targ to 1, our targ to 0, sp-- and return child's op_other.
-  (3) Blank targ and  TOPs and return op_next.
-Case 1 happens for a "..." with a matching lineno... or true TOPs.
-Case 2 happens for a ".." with a matching lineno... or true TOPs.
-Case 3 happens for a non-matching lineno or false TOPs.
-
-               $a = lhs..rhs;
-
-        ,------->  range
-        ^         /     \
-        |    true/       \false
-        |       /         \
-   first|     lhs        rhs
-        |      \   first   /
-        ^--- flip <----- flop
-                 \       /
-                  \     /
-                  sassign
-
-
-/* range */
-if (SvTRUE(curpad[op->op_targ]))
-    goto label(op_other);
-/* op_next */
-...
-/* flip */
-/* For "..." returns op_next. For ".." returns op_next or op_first->op_other */
-/* end of basic block */
-goto out;
-label(range op_other):
-...
-/* flop */
-out:
-...
diff --git a/ext/B/ramblings/magic b/ext/B/ramblings/magic
deleted file mode 100644 (file)
index e41930a..0000000
+++ /dev/null
@@ -1,93 +0,0 @@
-sv_magic()
-----------
-av.c
-av_store()
-       Storing a non-undef element into an SMAGICAL array, av,
-       assigns the equivalent lowercase form of magic (of the first
-       MAGIC in the chain) to the value (with obj = av, name = 0 and
-       namlen = array index).
-
-gv.c
-gv_init()
-       Initialising gv assigns '*' magic to it with obj = gv, name =
-       GvNAME and namlen = GvNAMELEN.
-gv_fetchpv()
-       @ISA gets 'I' magic with obj = gv, zero name and namlen.
-       %OVERLOAD gets 'A' magic with obj = gv, zero name and namlen.
-       $1 to $9, $&, $`, $', $+ get '\0' magic with obj = gv,
-       name = GvNAME and namlen = len ( = 1 presumably).
-Gv_AMupdate()
-       Stashes for overload magic seem to get 'c' magic with obj = 0,
-       name = &amt and namlen = sizeof(amt).
-hv_magic(hv, gv, how)
-       Gives magic how to hv with obj = gv and zero name and namlen.
-
-mg.c
-mg_copy(sv, nsv, key, klen)
-       Traverses the magic chain of sv. Upper case forms of magic
-       (only) are copied across to nsv, preserving obj but using
-       name = key and namlen = klen.
-magic_setpos()
-       LvTARG of a PVLV gets 'g' magic with obj = name = 0 and namlen = pos.
-
-op.c
-mod()
-       PVLV operators give magic to their targs with
-       obj = name = namlen = 0. OP_POS gives '.', OP_VEC gives 'v'
-       and OP_SUBSTR gives 'x'.
-
-perl.c
-magicname(sym, name, namlen)
-       Fetches/creates a GV with name sym and gives it '\0' magic
-       with obj = gv, name and namlen as passed.
-init_postdump_symbols()
-       Elements of the environment get given SVs with 'e' magic.
-       obj = sv and name and namlen point to the actual string
-       within env.
-
-pp.c
-pp_av2arylen()
-       $#foo gives '#' magic to the new SV with obj = av and
-       name = namlen = 0.
-pp_study()
-       SV gets 'g' magic with obj = name = namlen = 0.
-pp_substr()
-       PVLV gets 'x' magic with obj = name = namlen = 0.
-pp_vec()
-       PVLV gets 'x' magic with obj = name = namlen = 0.
-
-pp_hot.c
-pp_match()
-       m//g gets 'g' magic with obj = name = namlen = 0.
-
-pp_sys.c
-pp_tie()
-       sv gets magic with obj = sv and name = namlen = 0.
-       If an HV or an AV, it gets 'P' magic, otherwise 'q' magic.
-pp_dbmopen()
-       'P' magic for the HV just as with pp_tie().
-pp_sysread()
-       If tainting, the buffer SV gets 't' magic with
-       obj = name = namlen = 0.
-
-sv.c
-sv_setsv()
-       Doing sv_setsv(dstr, gv) gives '*' magic to dstr with
-       obj = dstr, name = GvNAME, namlen = GvNAMELEN.
-
-util.c
-fbm_compile()
-       The PVBM gets 'B' magic with obj = name = namlen = 0 and SvVALID
-       is set to indicate that the Boyer-Moore table is valid.
-       magic_setbm() just clears the SvVALID flag.
-
-hv_magic()
-----------
-
-gv.c
-gv_fetchfile()
-       With perldb, the HV of a gvfile gv gets 'L' magic with obj = gv.
-gv_fetchpv()
-       %SIG gets 'S' magic with obj = siggv.
-init_postdump_symbols()
-       %ENV gets 'E' magic with obj = envgv.
diff --git a/ext/B/ramblings/reg.alloc b/ext/B/ramblings/reg.alloc
deleted file mode 100644 (file)
index 7fd69f2..0000000
+++ /dev/null
@@ -1,32 +0,0 @@
-while ($i--) {
-    foo();
-}
-exit
-
-    PP code                    if i an int register    if i an int but not a
-                               (i.e. can't be          register (i.e. can be
-                               implicitly invalidated) implicitly invalidated)
-    nextstate
-    enterloop
-
-                                                       
-  loop:
-    gvsv  GV (0xe6078) *i      validates i             validates i
-    postdec                    invalidates $i          invalidates $i
-    and if_false goto out;
-                               i valid; $i invalid     i valid; $i invalid
-
-                               i valid; $i invalid     i valid; $i invalid
-    nextstate
-    pushmark
-    gv  GV (0xe600c) *foo
-    entersub                                           validates $i; invals i
-
-    unstack
-    goto loop:
-
-                               i valid; $i invalid
-  out:
-    leaveloop
-    nextstate
-    exit
diff --git a/ext/B/ramblings/runtime.porting b/ext/B/ramblings/runtime.porting
deleted file mode 100644 (file)
index 20d05b3..0000000
+++ /dev/null
@@ -1,357 +0,0 @@
-Notes on porting the perl runtime PP engine.
-Importance: 1 = who cares?, 10 = vital
-Difficulty: 1 = trivial, 10 = very difficult. Level assumes a
-reasonable implementation of the SV and OP API already ported.
-
-OP             Import  Diff    Comments
-null           10      1
-stub           10      1
-scalar         10      1
-pushmark       10      1       PUSHMARK
-wantarray      7       3       cxstack, dopoptosub
-const          10      1       
-gvsv           10      1       save_scalar
-gv             10      1       
-gelem          3       3       
-padsv          10      2       SAVECLEARSV, provide_ref
-padav          10      2
-padhv          10      2
-padany         1       1
-pushre         7       3       pushes an op. Blech.
-rv2gv          6       5
-rv2sv          10      4
-av2arylen      7       3       sv_magic        
-rv2cv          8       5       sv_2cv
-anoncode       7       6       cv_clone
-prototype      4       4       sv_2cv
-refgen         8       3
-srefgen                8       2
-ref            8       3
-bless          7       3
-backtick       5       4
-glob           5       2       do_readline
-readline       8       2       do_readline     
-rcatline       8       2
-regcmaybe      8       1
-regcreset      8       1
-regcomp                8       9       pregcomp
-match          8       10
-qr             8       1
-subst          8       10
-substcont      8       7
-trans          7       4       do_trans
-sassign                10      3       mg_find, SvSETMAGIC
-aassign                10      5       
-chop           8       3       do_chop
-schop          8       3       do_chop
-chomp          8       3       do_chomp
-schomp         8       3       do_chomp
-defined                10      2
-undef          10      3
-study          4       5
-pos            8       3       PVLV, mg_find
-preinc         10      2       sv_inc, SvSETMAGIC
-i_preinc
-predec         10      2       sv_dec, SvSETMAGIC
-i_predec
-postinc                10      2       sv_dec, SvSETMAGIC
-i_postinc
-postdec                10      2       sv_dec, SvSETMAGIC
-i_postdec
-pow            10      1
-multiply       10      1
-i_multiply     10      1
-divide         10      2
-i_divide       10      1
-modulo         10      2
-i_modulo       10      1
-repeat         6       4
-add            10      1
-i_add          10      1
-subtract       10      1
-i_subtract     10      1
-concat         10      2       mg_get
-stringify      10      2       sv_setpvn
-left_shift     10      1
-right_shift    10      1
-lt             10      1
-i_lt           10      1
-gt             10      1
-i_gt           10      1
-le             10      1
-i_le           10      1
-ge             10      1
-i_ge           10      1
-eq             10      1
-i_eq           10      1
-ne             10      1
-i_ne           10      1
-ncmp           10      1
-i_ncmp         10      1
-slt            10      2
-sgt            10      2
-sle            10      2
-sge            10      2
-seq            10      2       sv_eq
-sne            10      2
-scmp           10      2
-bit_and                10      2
-bit_xor                10      2
-bit_or         10      2
-negate         10      3
-i_negate       10      1
-not            10      1
-complement     10      3
-atan2          6       1
-sin            6       1
-cos            6       1
-rand           5       2
-srand          5       2
-exp            6       1
-log            6       2
-sqrt           6       2
-int            10      2
-hex            9       2
-oct            9       2
-abs            10      1
-length         10      1
-substr         10      4       PVLV
-vec            5       4
-index          9       3
-rindex         9       3
-sprintf                9       4       do_sprintf
-formline       6       7
-ord            6       2       
-chr            6       2
-crypt          3       2
-ucfirst                6       2
-lcfirst                6       2
-uc             6       2
-lc             6       2
-quotemeta      6       3
-rv2av          10      3       save_svref, mg_get, save_ary
-aelemfast      10      2       av_fetch
-aelem          10      3
-aslice         9       4
-each           10      3       hv_iternext
-values         10      3       do_kv
-keys           10      3       do_kv
-delete         10      3
-exists         10      3
-rv2hv          10      3       save_svref, mg_get, save_ary, do_kv
-helem          10      3       save_svref, provide_ref
-hslice         9       4
-unpack         9       6       lengthy
-pack           9       6       lengthy
-split          9       9
-join           10      4       do_join
-list           10      2
-lslice         9       4
-anonlist       10      2
-anonhash       10      3
-splice         9       6
-push           10      2
-pop            10      2
-shift          10      2
-unshift                10      2
-sort           6       7
-reverse                9       4
-grepstart      6       5       modifies flow of control
-grepwhile      6       5       modifies flow of control
-mapstart       1       1
-mapwhile       6       5       modifies flow of control
-range          7       3       modifies flow of control
-flip           7       4       modifies flow of control
-flop           7       4       modifies flow of control
-and            10      3       modifies flow of control
-or             10      3       modifies flow of control
-xor
-cond_expr      10      3       modifies flow of control
-andassign      7       3       modifies flow of control
-orassign       7       3       modifies flow of control
-method         8       5
-entersub       10      7
-leavesub       10      5
-leavesublv
-caller         2       8
-warn           9       3
-die            9       3
-reset          2       2
-lineseq                1       1
-nextstate      10      1       Update stack_sp from cxstack. FREETMPS.
-dbstate                3       7               
-unstack
-enter          10      3       cxstack, ENTER, SAVETMPS, PUSHBLOCK
-leave          10      3       cxstack, SAVETMPS, LEAVE, POPBLOCK
-scope          1       1
-enteriter      9       4       cxstack
-iter           9       3       cxstack
-enterloop      10      4
-leaveloop      10      4
-return         10      5
-last           9       6
-next           9       6
-redo           9       6
-dump           1       9       pp_goto
-goto           6       9
-exit           9       2       my_exit
-open           9       5       do_open
-close          9       3       do_close
-pipe_op                7       4
-fileno         9       2
-umask          4       2
-binmode                4       2
-tie            5       5       pp_entersub
-untie          5       2       sv_unmagic
-tied           5       2
-dbmopen                4       5
-dbmclose       4       2
-sselect                4       4
-select         7       3
-getc           7       2
-read           8       2       pp_sysread
-enterwrite     4       4       doform
-leavewrite     4       5
-prtf           4       4       do_sprintf
-print          8       6
-sysopen                8       2
-sysseek                8       2
-sysread                8       4
-syswrite       8       4       pp_send
-send           8       4
-recv           8       4       pp_sysread
-eof            9       2
-tell           9       3
-seek           9       2
-truncate       8       3
-fcntl          8       4       pp_ioctl
-ioctl          8       4
-flock          8       2
-socket         5       3
-sockpair       5       3
-bind           5       3
-connect                5       3
-listen         5       3
-accept         5       3
-shutdown       5       2
-gsockopt       5       3       pp_ssockopt
-ssockopt       5       3
-getsockname    5       3       pp_getpeername
-getpeername    5       3
-lstat          5       4       pp_stat
-stat           5       4       lengthy
-ftrread                5       2       cando
-ftrwrite       5       2       cando
-ftrexec                5       2       cando
-fteread                5       2       cando
-ftewrite       5       2       cando
-fteexec                5       2       cando
-ftis           5       2       cando
-fteowned       5       2       cando
-ftrowned       5       2       cando
-ftzero         5       2       cando
-ftsize         5       2       cando
-ftmtime                5       2       cando
-ftatime                5       2       cando
-ftctime                5       2       cando
-ftsock         5       2       cando
-ftchr          5       2       cando
-ftblk          5       2       cando
-ftfile         5       2       cando
-ftdir          5       2       cando
-ftpipe         5       2       cando
-ftlink         5       2       cando
-ftsuid         5       2       cando
-ftsgid         5       2       cando
-ftsvtx         5       2       cando
-fttty          5       2       cando
-fttext         5       4
-ftbinary       5       4       fttext
-chdir
-chown
-chroot
-unlink
-chmod
-utime
-rename
-link
-symlink
-readlink
-mkdir
-rmdir
-open_dir
-readdir
-telldir
-seekdir
-rewinddir
-closedir
-fork
-wait
-waitpid
-system
-exec
-kill
-getppid
-getpgrp
-setpgrp
-getpriority
-setpriority
-time
-tms
-localtime
-gmtime
-alarm
-sleep
-shmget
-shmctl
-shmread
-shmwrite
-msgget
-msgctl
-msgsnd
-msgrcv
-semget
-semctl
-semop
-require                6       9       doeval
-dofile         6       9       doeval
-entereval      6       9       doeval
-leaveeval      6       5
-entertry       7       4       modifies flow of control
-leavetry       7       3
-ghbyname
-ghbyaddr
-ghostent
-gnbyname
-gnbyaddr
-gnetent
-gpbyname
-gpbynumber
-gprotoent
-gsbyname
-gsbyport
-gservent
-shostent
-snetent
-sprotoent
-sservent
-ehostent
-enetent
-eprotoent
-eservent
-gpwnam
-gpwuid
-gpwent
-spwent
-epwent
-ggrnam
-ggrgid
-ggrent
-sgrent
-egrent
-getlogin
-syscall
-lock           6       1
-threadsv       6       2       unused if not USE_5005THREADS, absent post 5.8
-setstate       1       1       currently unused anywhere
-method_named   10      2
diff --git a/ext/B/t/asmdata.t b/ext/B/t/asmdata.t
deleted file mode 100644 (file)
index 4e03f23..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-#!./perl -Tw
-
-BEGIN {
-    if ($ENV{PERL_CORE}){
-       chdir('t') if -d 't';
-       @INC = ('.', '../lib');
-    } else {
-       unshift @INC, 't';
-    }
-    require Config;
-    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
-        print "1..0 # Skip -- Perl configured without B module\n";
-        exit 0;
-    }
-}
-
-use Test::More tests => 13;
-
-use_ok('B::Asmdata', qw(%insn_data @insn_name @optype @specialsv_name));
-
-# check we got something.
-isnt( keys %insn_data,  0,  '%insn_data exported and populated' );
-isnt( @insn_name,       0,  '   @insn_name' );
-isnt( @optype,          0,  '   @optype' );
-isnt( @specialsv_name,  0,  '   @specialsv_name' );
-
-# pick an op that's not likely to go away in the future
-my @data = values %insn_data;
-is( (grep { ref eq 'ARRAY' } @data),  @data,   '%insn_data contains arrays' );
-
-# pick one at random to test with.
-my $opname = (keys %insn_data)[rand @data];
-my $data = $insn_data{$opname};
-like( $data->[0], qr/^\d+$/,    '   op number' );
-is( ref $data->[1],  'CODE',    '   PUT code ref' );
-ok( !ref $data->[2],            '   GET method' );
-
-is( $insn_name[$data->[0]], $opname,    '@insn_name maps correctly' );
-
-
-# I'm going to assume that op types will all be named /OP$/.
-# If this changes in the future, change this test.
-is( grep(/OP$/, @optype), @optype,  '@optype is all /OP$/' );
-
-
-# comment in bytecode.pl says "Nullsv *must come first so that the 
-# condition ($$sv == 0) can continue to be used to test (sv == Nullsv)."
-is( $specialsv_name[0],  'Nullsv',  'Nullsv come first in @special_sv_name' );
-
-# other than that, we can't really say much more about @specialsv_name
-# than it has to contain strings (on the off chance &PL_sv_undef gets 
-# flubbed)
-is( grep(!ref, @specialsv_name), @specialsv_name,   '  contains all strings' );
diff --git a/ext/B/t/assembler.t b/ext/B/t/assembler.t
deleted file mode 100644 (file)
index b00c45c..0000000
+++ /dev/null
@@ -1,391 +0,0 @@
-#!./perl -w
-
-=pod
-
-=head1 TEST FOR B::Assembler.pm AND B::Disassembler.pm
-
-=head2 Description
-
-The general idea is to test by assembling a choice set of assembler
-instructions, then disassemble them, and check that we've completed the
-round trip. Also, error checking of Assembler.pm is tested by feeding
-it assorted errors.
-
-Since Assembler.pm likes to assemble a file, we comply by writing a
-text file. This file contains three sections:
-
-  testing operand categories
-  use each opcode
-  erronous assembler instructions
-
-An "operand category" is identified by the suffix of the PUT_/GET_
-subroutines as shown in the C<%Asmdata::insn_data> initialization, e.g.
-opcode C<ldsv> has operand category C<svindex>:
-
-   insn_data{ldsv} = [1, \&PUT_svindex, "GET_svindex"];
-
-Because Disassembler.pm also assumes input from a file, we write the
-resulting object code to a file. And disassembled output is written to
-yet another text file which is then compared to the original input.
-(Erronous assembler instructions still generate code, but this is not
-written to the object file; therefore disassembly bails out at the first
-instruction in error.)
-
-All files are kept in memory by using TIEHASH.
-
-
-=head2 Caveats
-
-An error where Assembler.pm and Disassembler.pm agree but Assembler.pm
-generates invalid object code will not be detected.
-
-Due to the way this test has been set up, failure of a single test
-could cause all subsequent tests to fail as well: After an unexpected
-assembler error no output is written, and disassembled lines will be
-out of sync for all lines thereafter.
-
-Not all possibilities for writing a valid operand value can be tested
-because disassembly results in a uniform representation.
-
-
-=head2 Maintenance
-
-New opcodes are added automatically.
-
-A new operand category will cause this program to die ("no operand list
-for XXX"). The cure is to add suitable entries to C<%goodlist> and
-C<%badlist>. (Since the data in Asmdata.pm is autogenerated, it may also
-happen that the corresponding assembly or disassembly subroutine is
-missing.) Note that an empty array as a C<%goodlist> entry means that
-opcodes of the operand category do not take an operand (and therefore the
-corresponding entry in C<%badlist> should have one). An C<undef> entry
-in C<%badlist> means that any value is acceptable (and thus there is no
-way to cause an error).
-
-Set C<$dbg> to debug this test.
-
-=cut
-
-package VirtFile;
-use strict;
-
-# Note: This is NOT a general purpose package. It implements
-# sequential text and binary file i/o in a rather simple form.
-
-sub TIEHANDLE($;$){
-    my( $class, $data ) = @_;
-    my $obj = { data => defined( $data ) ? $data : '',
-                pos => 0 };
-    return bless( $obj, $class );
-}
-
-sub PRINT($@){
-    my( $self ) = shift;
-    $self->{data} .= join( '', @_ );
-}
-
-sub WRITE($$;$$){
-    my( $self, $buf, $len, $offset ) = @_;
-    unless( defined( $len ) ){
-       $len = length( $buf );
-        $offset = 0;
-    }
-    unless( defined( $offset ) ){
-        $offset = 0;
-    }
-    $self->{data} .= substr( $buf, $offset, $len );
-    return $len;
-}
-
-
-sub GETC($){
-    my( $self ) = @_;
-    return undef() if $self->{pos} >= length( $self->{data} );
-    return substr( $self->{data}, $self->{pos}++, 1 );
-}
-
-sub READLINE($){
-    my( $self ) = @_;
-    return undef() if $self->{pos} >= length( $self->{data} );
-    my $lfpos = index( $self->{data}, "\n", $self->{pos} );
-    if( $lfpos < 0 ){
-        $lfpos = length( $self->{data} );
-    }
-    my $pos = $self->{pos};
-    $self->{pos} = $lfpos + 1;
-    return substr( $self->{data}, $pos, $self->{pos} - $pos );
-}
-
-sub READ($@){
-    my $self = shift();
-    my $bufref = \$_[0];
-    my( undef, $len, $offset ) = @_;
-    if( $offset ){
-        die( "offset beyond end of buffer\n" )
-          if ! defined( $$bufref ) || $offset > length( $$bufref );
-    } else {
-        $$bufref = '';
-        $offset = 0;
-    }
-    my $remlen = length( $self->{data} ) - $self->{pos};
-    $len = $remlen if $remlen < $len;
-    return 0 unless $len;
-    substr( $$bufref, $offset, $len ) =
-      substr( $self->{data}, $self->{pos}, $len );
-    $self->{pos} += $len;
-    return $len;
-}
-
-sub TELL($){
-    my $self = shift();
-    return $self->{pos};
-}
-
-sub CLOSE($){
-    my( $self ) = @_;
-    $self->{pos} = 0;
-}
-
-1;
-
-package main;
-
-use strict;
-use Test::More;
-use Config qw(%Config);
-
-BEGIN {
-  if (($Config{'extensions'} !~ /\bB\b/) ){
-    print "1..0 # Skip -- Perl configured without B module\n";
-    exit 0;
-  }
-  if (($Config{'extensions'} !~ /\bByteLoader\b/) ){
-    print "1..0 # Skip -- Perl configured without ByteLoader module\n";
-    exit 0;
-  }
-}
-
-use B::Asmdata      qw( %insn_data );
-use B::Assembler    qw( &assemble_fh );
-use B::Disassembler qw( &disassemble_fh &get_header );
-
-my( %opsByType, @code2name );
-my( $lineno, $dbg, $firstbadline, @descr );
-$dbg = 0; # debug switch
-
-# $SIG{__WARN__} handler to catch Assembler error messages
-#
-my $warnmsg;
-sub catchwarn($){
-    $warnmsg = $_[0];
-    print "error: $warnmsg\n" if $dbg;
-}
-
-# Callback for writing assembled bytes. This is where we check
-# that we do get an error.
-#
-sub putobj($){
-    if( ++$lineno >= $firstbadline ){
-        ok( $warnmsg && $warnmsg =~ /^\d+:\s/, $descr[$lineno] );
-        undef( $warnmsg );
-    } else {
-        my $l = syswrite( OBJ, $_[0] );
-    }
-}
-
-# Callback for writing a disassembled statement.
-#
-sub putdis(@){
-    my $line = join( ' ', @_ );
-    ++$lineno;
-    print DIS "$line\n";
-    printf "%5d %s\n", $lineno, $line if $dbg;
-}
-
-# Generate assembler instructions from a hash of operand types: each
-# existing entry contains a list of good or bad operand values. The
-# corresponding opcodes can be found in %opsByType.
-#
-sub gen_type($$$){
-    my( $href, $descref, $text ) = @_;
-    for my $odt ( sort( keys( %opsByType ) ) ){
-        my $opcode = $opsByType{$odt}->[0];
-       my $sel = $odt;
-       $sel =~ s/^GET_//;
-       die( "no operand list for $sel\n" ) unless exists( $href->{$sel} );
-        if( defined( $href->{$sel} ) ){
-            if( @{$href->{$sel}} ){
-               for my $od ( @{$href->{$sel}} ){
-                   ++$lineno;
-                    $descref->[$lineno] = "$text: $code2name[$opcode] $od";
-                   print ASM "$code2name[$opcode] $od\n";
-                   printf "%5d %s %s\n", $lineno, $code2name[$opcode], $od if $dbg;
-               }
-           } else {
-               ++$lineno;
-                $descref->[$lineno] = "$text: $code2name[$opcode]";
-               print ASM "$code2name[$opcode]\n";
-               printf "%5d %s\n", $lineno, $code2name[$opcode] if $dbg;
-           }
-       }
-    }
-}
-
-# Interesting operand values
-#
-my %goodlist = (
-comment_t   => [ '"a comment"' ],  # no \n
-none        => [],
-svindex     => [ 0x7fffffff, 0 ],
-opindex     => [ 0x7fffffff, 0 ],
-pvindex     => [ 0x7fffffff, 0 ],
-U32         => [ 0xffffffff, 0 ],
-U8          => [ 0xff, 0 ],
-PV          => [ '""', '"a string"', ],
-I32         => [ -0x80000000, 0x7fffffff ],
-IV64        => [ '0x000000000', '0x0ffffffff', '0x000000001' ], # disass formats  0x%09x
-IV          => $Config{ivsize} == 4 ?
-               [ -0x80000000, 0x7fffffff ] :
-               [ '0x000000000', '0x0ffffffff', '0x000000001' ],
-NV          => [ 1.23456789E3 ],
-U16         => [ 0xffff, 0 ],
-pvcontents  => [],
-strconst    => [ '""', '"another string"' ], # no NUL
-op_tr_array => [ join( ',', 256, 0..255 ) ],
-PADOFFSET   => undef,
-long        => undef,
-svtype      => undef,
-             );
-
-# Erronous operand values
-#
-my %badlist = (
-comment_t   => [ '"multi-line\ncomment"' ],  # no \n
-none        => [ '"spurious arg"'  ],
-svindex     => [ 0xffffffff * 2, -1 ],
-opindex     => [ 0xffffffff * 2, -2 ],
-pvindex     => [ 0xffffffff * 2, -3 ],
-U32         => [ 0xffffffff * 2, -4 ],
-U16         => [ 0x5ffff, -5 ],
-U8          => [ 0x6ff, -6 ],
-PV          => [ 'no quote"' ],
-I32         => [ -0x80000001, 0x80000000 ],
-IV64        => undef, # PUT_IV64 doesn't check - no integrity there
-IV          => $Config{ivsize} == 4 ?
-               [ -0x80000001, 0x80000000 ] : undef,
-NV          => undef, # PUT_NV accepts anything - it shouldn't, real-ly
-pvcontents  => [ '"spurious arg"' ],
-strconst    => [  'no quote"',  '"with NUL '."\0".' char"' ], # no NUL
-op_tr_array => undef, # op_pv_tr is no longer exactly 256 shorts
-PADOFFSET   => undef,
-long       => undef,
-svtype     => undef,
-             );
-
-
-# Determine all operand types from %Asmdata::insn_data
-#
-for my $opname ( keys( %insn_data ) ){
-    my ( $opcode, $put, $getname ) = @{$insn_data{$opname}};
-    push( @{$opsByType{$getname}}, $opcode );
-    $code2name[$opcode] = $opname;
-}
-
-
-# Write instruction(s) for correct operand values each operand type class
-#
-$lineno = 0;
-tie( *ASM, 'VirtFile' );
-gen_type( \%goodlist, \@descr, 'round trip' );
-
-# Write one instruction for each opcode.
-#
-for my $opcode ( 0..$#code2name ){
-    next unless defined( $code2name[$opcode] );
-    my $sel = $insn_data{$code2name[$opcode]}->[2];
-    $sel =~ s/^GET_//;
-    die( "no operand list for $sel\n" ) unless exists( $goodlist{$sel} );
-    if( defined( $goodlist{$sel} ) ){
-        ++$lineno;
-        if( @{$goodlist{$sel}} ){
-            my $od = $goodlist{$sel}[0];
-            $descr[$lineno] = "round trip: $code2name[$opcode] $od";
-            print ASM "$code2name[$opcode] $od\n";
-            printf "%5d %s %s\n", $lineno, $code2name[$opcode], $od if $dbg;
-        } else {
-            $descr[$lineno] = "round trip: $code2name[$opcode]";
-            print ASM "$code2name[$opcode]\n";
-            printf "%5d %s\n", $lineno, $code2name[$opcode] if $dbg;
-       }
-    }
-} 
-
-# Write instruction(s) for incorrect operand values each operand type class
-#
-$firstbadline = $lineno + 1;
-gen_type( \%badlist, \@descr, 'asm error' );
-
-# invalid opcode is an odd-man-out ;-)
-#
-++$lineno;
-$descr[$lineno] = "asm error: Gollum";
-print ASM "Gollum\n";
-printf "%5d %s\n", $lineno, 'Gollum' if $dbg;
-
-close( ASM );
-
-# Now that we have defined all of our tests: plan
-#
-plan( tests => $lineno );
-print "firstbadline=$firstbadline\n" if $dbg;
-
-# assemble (guard against warnings and death from assembly errors)
-#
-$SIG{'__WARN__'} = \&catchwarn;
-
-$lineno = -1; # account for the assembly header
-tie( *OBJ, 'VirtFile' );
-eval { assemble_fh( \*ASM, \&putobj ); };
-print "eval: $@" if $dbg;
-close( ASM );
-close( OBJ );
-$SIG{'__WARN__'} = 'DEFAULT';
-
-# disassemble
-#
-print "--- disassembling ---\n" if $dbg;
-$lineno = 0;
-tie( *DIS, 'VirtFile' );
-disassemble_fh( \*OBJ, \&putdis );
-close( OBJ );
-close( DIS );
-
-# get header (for debugging only)
-#
-if( $dbg ){
-    my( $magic, $archname, $blversion, $ivsize, $ptrsize, $byteorder ) =
-        get_header();
-    printf "Magic:        0x%08x\n", $magic;
-    print  "Architecture: $archname\n";
-    print  "Byteloader V: $blversion\n";
-    print  "ivsize:       $ivsize\n";
-    print  "ptrsize:      $ptrsize\n";
-    print  "Byteorder:    $byteorder\n";
-}
-
-# check by comparing files line by line
-#
-print "--- checking ---\n" if $dbg;
-$lineno = 0;
-my( $asmline, $disline );
-while( defined( $asmline = <ASM> ) ){
-    $disline = <DIS>;
-    ++$lineno;
-    last if $lineno eq $firstbadline; # bail out where errors begin
-    ok( $asmline eq $disline, $descr[$lineno] );
-    printf "%5d %s\n", $lineno, $asmline if $dbg;
-}
-close( ASM );
-close( DIS );
-
-__END__
diff --git a/ext/B/t/bblock.t b/ext/B/t/bblock.t
deleted file mode 100644 (file)
index 4979ea5..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-#!./perl -Tw
-
-BEGIN {
-    if ($ENV{PERL_CORE}){
-       chdir('t') if -d 't';
-       @INC = ('.', '../lib');
-    } else {
-       unshift @INC, 't';
-    }
-    require Config;
-    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
-        print "1..0 # Skip -- Perl configured without B module\n";
-        exit 0;
-    }
-}
-
-use Test::More tests => 1;
-
-use_ok('B::Bblock', qw(find_leaders));
-
-# Someone who understands what this module does, please fill this out.
diff --git a/ext/B/t/bytecode.t b/ext/B/t/bytecode.t
deleted file mode 100644 (file)
index 3c7d282..0000000
+++ /dev/null
@@ -1,167 +0,0 @@
-#!./perl
-my $keep_plc      = 0; # set it to keep the bytecode files
-my $keep_plc_fail = 1; # set it to keep the bytecode files on failures
-
-BEGIN {
-    if ($^O eq 'VMS') {
-       print "1..0 # skip - Bytecode/ByteLoader doesn't work on VMS\n";
-       exit 0;
-    }
-    if ($ENV{PERL_CORE}){
-       chdir('t') if -d 't';
-       @INC = ('.', '../lib');
-    } else {
-       unshift @INC, 't';
-       push @INC, "../../t";
-    }
-    use Config;
-    if (($Config{'extensions'} !~ /\bB\b/) ){
-        print "1..0 # Skip -- Perl configured without B module\n";
-        exit 0;
-    }
-    if ($Config{ccflags} =~ /-DPERL_OLD_COPY_ON_WRITE/) {
-       print "1..0 # skip - no COW for now\n";
-       exit 0;
-    }
-    require 'test.pl'; # for run_perl()
-}
-use strict;
-
-undef $/;
-my @tests = split /\n###+\n/, <DATA>;
-
-print "1..".($#tests+1)."\n";
-
-my $cnt = 1;
-my $test;
-
-for (@tests) {
-    my $got;
-    my ($script, $expect) = split />>>+\n/;
-    $expect =~ s/\n$//;
-    $test = "bytecode$cnt.pl";
-    open T, ">$test"; print T $script; close T;
-    $got = run_perl(switches => [ "-MO=Bytecode,-H,-o${test}c" ],
-                   verbose  => 0, # for debugging
-                   stderr   => 1, # to capture the "bytecode.pl syntax ok"
-                   progfile => $test);
-    unless ($?) {
-       $got = run_perl(progfile => "${test}c"); # run the .plc
-       unless ($?) {
-           if ($got =~ /^$expect$/) {
-               print "ok $cnt\n";
-               next;
-           } else {
-               $keep_plc = $keep_plc_fail unless $keep_plc;
-               print <<"EOT"; next;
-not ok $cnt
---------- SCRIPT
-$script
---------- GOT
-$got
---------- EXPECT
-$expect
-----------------
-
-EOT
-           }
-       }
-    }
-    print <<"EOT";
-not ok $cnt
---------- SCRIPT
-$script
---------- \$\? = $?
-$got
-EOT
-} continue {
-    1 while unlink($test, $keep_plc ? () : "${test}c");
-    $cnt++;
-}
-
-__DATA__
-
-print 'hi'
->>>>
-hi
-############################################################
-for (1,2,3) { print if /\d/ }
->>>>
-123
-############################################################
-$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/ge; print $_
->>>>
-zzz2y2y2
-############################################################
-$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/g; print $_
->>>>
-z2y2y2
-############################################################
-split /a/,"bananarama"; print @_
->>>>
-bnnrm
-############################################################
-{ package P; sub x { print 'ya' } x }
->>>>
-ya
-############################################################
-@z = split /:/,"b:r:n:f:g"; print @z
->>>>
-brnfg
-############################################################
-sub AUTOLOAD { print 1 } &{"a"}()
->>>>
-1
-############################################################
-my $l = 3; $x = sub { print $l }; &$x
->>>>
-3
-############################################################
-my $i = 1;
-my $foo = sub {$i = shift if @_};
-&$foo(3);
-print 'ok';
->>>>
-ok
-############################################################
-$x="Cannot use"; print index $x, "Can"
->>>>
-0
-############################################################
-my $i=6; eval "print \$i\n"
->>>>
-6
-############################################################
-BEGIN { %h=(1=>2,3=>4) } print $h{3}
->>>>
-4
-############################################################
-open our $T,"a";
-print 'ok';
->>>>
-ok
-############################################################
-print <DATA>
-__DATA__
-a
-b
->>>>
-a
-b
-############################################################
-BEGIN { tie @a, __PACKAGE__; sub TIEARRAY { bless{} } sub FETCH { 1 } }
-print $a[1]
->>>>
-1
-############################################################
-my $i=3; print 1 .. $i
->>>>
-123
-############################################################
-my $h = { a=>3, b=>1 }; print sort {$h->{$a} <=> $h->{$b}} keys %$h
->>>>
-ba
-############################################################
-print sort { my $p; $b <=> $a } 1,4,3
->>>>
-431
diff --git a/ext/B/t/stash.t b/ext/B/t/stash.t
deleted file mode 100755 (executable)
index 9d6879b..0000000
+++ /dev/null
@@ -1,99 +0,0 @@
-#!./perl
-
-BEGIN {
-    if ($ENV{PERL_CORE}){
-       chdir('t') if -d 't';
-       if ($^O eq 'MacOS') {
-           @INC = qw(: ::lib ::macos:lib);
-       } else {
-           @INC = '.';
-           push @INC, '../lib';
-       }
-    } else {
-       unshift @INC, 't';
-    }
-    require Config;
-    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
-        print "1..0 # Skip -- Perl configured without B module\n";
-        exit 0;
-    }
-}
-
-$|  = 1;
-use warnings;
-use strict;
-use Config;
-
-print "1..1\n";
-
-my $test = 1;
-
-sub ok { print "ok $test\n"; $test++ }
-
-
-my $got;
-my $Is_VMS = $^O eq 'VMS';
-my $Is_MacOS = $^O eq 'MacOS';
-
-my $path = join " ", map { qq["-I$_"] } @INC;
-$path = '"-I../lib" "-Iperl_root:[lib]"' if $Is_VMS;   # gets too long otherwise
-my $redir = $Is_MacOS ? "" : "2>&1";
-
-chomp($got = `$^X $path "-MB::Stash" "-Mwarnings" -e1`);
-
-$got =~ s/-u//g;
-
-print "# got = $got\n";
-
-my @got = map { s/^\S+ //; $_ }
-              sort { $a cmp $b }
-                   map { lc($_) . " " . $_ }
-                       split /,/, $got;
-
-print "# (after sorting)\n";
-print "# got = @got\n";
-
-@got = grep { ! /^(PerlIO|open)(?:::\w+)?$/ } @got;
-
-print "# (after perlio censorings)\n";
-print "# got = @got\n";
-
-@got = grep { ! /^Win32$/                     } @got  if $^O eq 'MSWin32';
-@got = grep { ! /^NetWare$/                   } @got  if $^O eq 'NetWare';
-@got = grep { ! /^(Cwd|File|File::Copy|OS2)$/ } @got  if $^O eq 'os2';
-@got = grep { ! /^(Cwd|Cygwin)$/              } @got  if $^O eq 'cygwin';
-
-if ($Is_VMS) {
-    @got = grep { ! /^File(?:::Copy)?$/    } @got;
-    @got = grep { ! /^VMS(?:::Filespec)?$/ } @got;
-    @got = grep { ! /^vmsish$/             } @got;
-     # Socket is optional/compiler version dependent
-    @got = grep { ! /^Socket$/             } @got;
-}
-
-print "# (after platform censorings)\n";
-print "# got = @got\n";
-
-$got = "@got";
-
-my $expected = "attributes Carp Carp::Heavy DB Internals main Regexp utf8 version warnings";
-
-if ($] < 5.009) {
-    $expected =~ s/version //;
-    $expected =~ s/DB/DB Exporter Exporter::Heavy/;
-}
-
-{
-    no strict 'vars';
-    use vars '$OS2::is_aout';
-}
-
-if ((($Config{static_ext} eq ' ') || ($Config{static_ext} eq ''))
-    && !($^O eq 'os2' and $OS2::is_aout)
-       ) {
-    print "# got [$got]\n# vs.\n# expected [$expected]\nnot " if $got ne $expected;
-    ok;
-} else {
-    print "ok $test # skipped: one or more static extensions\n"; $test++;
-}
-
diff --git a/ext/ByteLoader/ByteLoader.pm b/ext/ByteLoader/ByteLoader.pm
deleted file mode 100644 (file)
index 5ff3c91..0000000
+++ /dev/null
@@ -1,40 +0,0 @@
-package ByteLoader;
-
-use XSLoader ();
-
-our $VERSION = '0.06';
-
-XSLoader::load 'ByteLoader', $VERSION;
-
-1;
-__END__
-
-=head1 NAME
-
-ByteLoader - load byte compiled perl code
-
-=head1 SYNOPSIS
-
-  use ByteLoader 0.06;
-  <byte code>
-
-  or just
-
-  perl -MByteLoader bytecode_file
-
-=head1 DESCRIPTION
-
-This module is used to load byte compiled perl code as produced by
-C<perl -MO=Bytecode=...>. It uses the source filter mechanism to read
-the byte code and insert it into the compiled code at the appropriate point.
-
-=head1 AUTHOR
-
-Tom Hughes <tom@compton.nu> based on the ideas of Tim Bunce and others.
-Many changes by Enache Adrian <enache@rdslink.ro> 2003 a.d.
-
-=head1 SEE ALSO
-
-perl(1).
-
-=cut
diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs
deleted file mode 100644 (file)
index 679298e..0000000
+++ /dev/null
@@ -1,135 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include "byterun.h"
-
-/* Something arbitary for a buffer size */
-#define BYTELOADER_BUFFER 8096
-
-int
-bl_getc(struct byteloader_fdata *data)
-{
-    dTHX;
-    if (SvCUR(data->datasv) <= (STRLEN)data->next_out) {
-      int result;
-      /* Run out of buffered data, so attempt to read some more */
-      *(SvPV_nolen (data->datasv)) = '\0';
-      SvCUR_set (data->datasv, 0);
-      data->next_out = 0;
-      result = FILTER_READ (data->idx + 1, data->datasv, BYTELOADER_BUFFER);
-
-      /* Filter returned error, or we got EOF and no data, then return EOF.
-        Not sure if filter is allowed to return EOF and add data simultaneously
-        Think not, but will bullet proof against it. */
-      if (result < 0 || SvCUR(data->datasv) == 0)
-       return EOF;
-      /* Else there must be at least one byte present, which is good enough */
-    }
-
-    return *((U8 *) SvPV_nolen (data->datasv) + data->next_out++);
-}
-
-int
-bl_read(struct byteloader_fdata *data, char *buf, size_t size, size_t n)
-{
-    dTHX;
-    char *start;
-    STRLEN len;
-    size_t wanted = size * n;
-
-    start = SvPV (data->datasv, len);
-    if (len < (data->next_out + wanted)) {
-      int result;
-
-      /* Shuffle data to start of buffer */
-      len -= data->next_out;
-      if (len) {
-       memmove (start, start + data->next_out, len + 1);
-      } else {
-       *start = '\0';  /* Avoid call to memmove. */
-      }
-      SvCUR_set(data->datasv, len);
-      data->next_out = 0;
-
-      /* Attempt to read more data. */
-      do {
-       result = FILTER_READ (data->idx + 1, data->datasv, BYTELOADER_BUFFER);
-       
-       start = SvPV (data->datasv, len);
-      } while (result > 0 && len < wanted);
-      /* Loop while not (EOF || error) and short reads */
-
-      /* If not enough data read, truncate copy */
-      if (wanted > len)
-       wanted = len;
-    }
-
-    if (wanted > 0) {
-      memcpy (buf, start + data->next_out, wanted);
-       data->next_out += wanted;
-      wanted /= size;
-    }
-    return (int) wanted;
-}
-
-static I32
-byteloader_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
-{
-    OP *saveroot = PL_main_root;
-    OP *savestart = PL_main_start;
-    struct byteloader_state bstate;
-    struct byteloader_fdata data;
-    int len;
-    (void)buf_sv;
-    (void)maxlen;
-
-    data.next_out = 0;
-    data.datasv = FILTER_DATA(idx);
-    data.idx = idx;
-
-    bstate.bs_fdata = &data;
-    bstate.bs_obj_list = Null(void**);
-    bstate.bs_obj_list_fill = -1;
-    bstate.bs_sv = Nullsv;
-    bstate.bs_iv_overflows = 0;
-
-/* KLUDGE */
-    if (byterun(aTHX_ &bstate)
-           && (len = SvCUR(data.datasv) - (STRLEN)data.next_out))
-    {
-       PerlIO_seek(PL_rsfp, -len, SEEK_CUR);
-       PL_rsfp = NULL;
-    }
-    filter_del(byteloader_filter);
-
-    if (PL_in_eval) {
-        OP *o;
-
-        PL_eval_start = PL_main_start;
-
-        o = newSVOP(OP_CONST, 0, newSViv(1));
-        PL_eval_root = newLISTOP(OP_LINESEQ, 0, PL_main_root, o);
-        PL_main_root->op_next = o;
-        PL_eval_root = newUNOP(OP_LEAVEEVAL, 0, PL_eval_root);
-        o->op_next = PL_eval_root;
-    
-        PL_main_root = saveroot;
-        PL_main_start = savestart;
-    }
-
-    return 0;
-}
-
-MODULE = ByteLoader            PACKAGE = ByteLoader
-
-PROTOTYPES:    ENABLE
-
-void
-import(package="ByteLoader", ...)
-  char *package
-  PREINIT:
-    SV *sv = newSVpvn ("", 0);
-  PPCODE:
-    if (!sv)
-      croak ("Could not allocate ByteLoader buffers");
-    filter_add(byteloader_filter, sv);
diff --git a/ext/ByteLoader/Makefile.PL b/ext/ByteLoader/Makefile.PL
deleted file mode 100644 (file)
index c3cfcc7..0000000
+++ /dev/null
@@ -1,9 +0,0 @@
-use ExtUtils::MakeMaker;
-
-WriteMakefile(
-    NAME               => 'ByteLoader',
-    VERSION_FROM       => 'ByteLoader.pm',
-    XSPROTOARG         => '-noprototypes',
-    MAN3PODS           => {},     # Pods will be built by installman.
-    OBJECT             => 'byterun$(OBJ_EXT) ByteLoader$(OBJ_EXT)',
-);
diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
deleted file mode 100644 (file)
index 160ae61..0000000
+++ /dev/null
@@ -1,435 +0,0 @@
-typedef char *pvcontents;
-typedef char *strconst;
-typedef U32 PV;
-typedef char *op_tr_array;
-typedef int comment_t;
-typedef SV *svindex;
-typedef OP *opindex;
-typedef char *pvindex;
-
-#define BGET_FREAD(argp, len, nelem)   \
-        bl_read(bstate->bs_fdata,(char*)(argp),(len),(nelem))
-#define BGET_FGETC() bl_getc(bstate->bs_fdata)
-
-/* all this should be made endianness-agnostic */
-
-#define BGET_U8(arg) STMT_START {                                      \
-       const int _arg = BGET_FGETC();                                  \
-       if (_arg < 0) {                                                 \
-           Perl_croak(aTHX_                                            \
-                      "EOF or error while trying to read 1 byte for U8"); \
-       }                                                               \
-       arg = (U8) _arg;                                                \
-    } STMT_END
-
-#define BGET_U16(arg)          BGET_OR_CROAK(arg, U16)
-#define BGET_I32(arg)          BGET_OR_CROAK(arg, U32)
-#define BGET_U32(arg)          BGET_OR_CROAK(arg, U32)
-#define BGET_IV(arg)           BGET_OR_CROAK(arg, IV)
-#define BGET_PADOFFSET(arg)    BGET_OR_CROAK(arg, PADOFFSET)
-#define BGET_long(arg)         BGET_OR_CROAK(arg, long)
-#define BGET_svtype(arg)       BGET_OR_CROAK(arg, svtype)
-
-#define BGET_OR_CROAK(arg, type) STMT_START {                          \
-       if (BGET_FREAD(&arg, sizeof(type), 1) < 1) {                    \
-           Perl_croak(aTHX_                                            \
-                      "EOF or error while trying to read %d bytes for %s", \
-                      sizeof(type), STRINGIFY(type));                  \
-       }                                                               \
-    } STMT_END
-
-#define BGET_PV(arg)   STMT_START {                                    \
-       BGET_U32(arg);                                                  \
-       if (arg) {                                                      \
-           Newx(bstate->bs_pv.pvx, arg, char);                 \
-           bl_read(bstate->bs_fdata, bstate->bs_pv.pvx, arg, 1);       \
-           bstate->bs_pv.xpv.xpv_len = arg;                            \
-           bstate->bs_pv.xpv.xpv_cur = arg - 1;                        \
-       } else {                                                        \
-           bstate->bs_pv.pvx = 0;                                      \
-           bstate->bs_pv.xpv.xpv_len = 0;                              \
-           bstate->bs_pv.xpv.xpv_cur = 0;                              \
-       }                                                               \
-    } STMT_END
-
-#ifdef BYTELOADER_LOG_COMMENTS
-#  define BGET_comment_t(arg) \
-    STMT_START {                                                       \
-       char buf[1024];                                                 \
-       int i = 0;                                                      \
-       do {                                                            \
-           arg = BGET_FGETC();                                         \
-           buf[i++] = (char)arg;                                       \
-       } while (arg != '\n' && arg != EOF);                            \
-       buf[i] = '\0';                                                  \
-       PerlIO_printf(PerlIO_stderr(), "%s", buf);                      \
-    } STMT_END
-#else
-#  define BGET_comment_t(arg) \
-       do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF)
-#endif
-
-
-#define BGET_op_tr_array(arg) do {                     \
-       unsigned short *ary, len;                       \
-       BGET_U16(len);                                  \
-       Newx(ary, len, unsigned short);         \
-       BGET_FREAD(ary, sizeof(unsigned short), len);   \
-       arg = (char *) ary;                             \
-    } while (0)
-
-#define BGET_pvcontents(arg)   arg = bstate->bs_pv.pvx
-#define BGET_strconst(arg) STMT_START {        \
-       for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \
-       arg = PL_tokenbuf;                      \
-    } STMT_END
-
-#define BGET_NV(arg) STMT_START {      \
-       char *str;                      \
-       BGET_strconst(str);             \
-       arg = Atof(str);                \
-    } STMT_END
-
-#define BGET_objindex(arg, type) STMT_START {  \
-       BGET_U32(ix);                           \
-       arg = (type)bstate->bs_obj_list[ix];    \
-    } STMT_END
-#define BGET_svindex(arg) BGET_objindex(arg, svindex)
-#define BGET_opindex(arg) BGET_objindex(arg, opindex)
-#define BGET_pvindex(arg) STMT_START {                 \
-       BGET_objindex(arg, pvindex);                    \
-       arg = arg ? savepv(arg) : arg;                  \
-    } STMT_END
-
-#define BSET_ldspecsv(sv, arg) STMT_START {                            \
-       if(arg >= sizeof(specialsv_list) / sizeof(specialsv_list[0])) { \
-           Perl_croak(aTHX_ "Out of range special SV number %d", arg); \
-       }                                                               \
-       sv = specialsv_list[arg];                                       \
-    } STMT_END
-
-#define BSET_ldspecsvx(sv, arg) STMT_START {   \
-       BSET_ldspecsv(sv, arg);                 \
-       BSET_OBJ_STOREX(sv);                    \
-    } STMT_END
-
-#define BSET_stpv(pv, arg) STMT_START {                \
-       BSET_OBJ_STORE(pv, arg);                \
-       SAVEFREEPV(pv);                         \
-    } STMT_END
-                                   
-#define BSET_sv_refcnt_add(svrefcnt, arg)      svrefcnt += arg
-#define BSET_gp_refcnt_add(gprefcnt, arg)      gprefcnt += arg
-#define BSET_gp_share(sv, arg) STMT_START {    \
-       gp_free((GV*)sv);                       \
-       GvGP(sv) = GvGP(arg);                   \
-    } STMT_END
-
-#define BSET_gv_fetchpv(sv, arg)       sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV)
-#define BSET_gv_fetchpvx(sv, arg) STMT_START { \
-       BSET_gv_fetchpv(sv, arg);               \
-       BSET_OBJ_STOREX(sv);                    \
-    } STMT_END
-
-#define BSET_gv_stashpv(sv, arg)       sv = (SV*)gv_stashpv(arg, TRUE)
-#define BSET_gv_stashpvx(sv, arg) STMT_START { \
-       BSET_gv_stashpv(sv, arg);               \
-       BSET_OBJ_STOREX(sv);                    \
-    } STMT_END
-
-#define BSET_sv_magic(sv, arg)         sv_magic(sv, Nullsv, arg, 0, 0)
-#define BSET_mg_name(mg, arg)  mg->mg_ptr = arg; mg->mg_len = bstate->bs_pv.xpv.xpv_cur
-#define BSET_mg_namex(mg, arg)                 \
-       (mg->mg_ptr = (char*)SvREFCNT_inc((SV*)arg),    \
-        mg->mg_len = HEf_SVKEY)
-#define BSET_xmg_stash(sv, arg) *(SV**)&(((XPVMG*)SvANY(sv))->xmg_stash) = (arg)
-#define BSET_sv_upgrade(sv, arg)       (void)SvUPGRADE(sv, arg)
-#define BSET_xrv(sv, arg) SvRV_set(sv, arg)
-#define BSET_xpv(sv)   do {    \
-       SvPV_set(sv, bstate->bs_pv.pvx);        \
-       SvCUR_set(sv, bstate->bs_pv.xpv.xpv_cur);       \
-       SvLEN_set(sv, bstate->bs_pv.xpv.xpv_len);       \
-    } while (0)
-#define BSET_xpv_cur(sv, arg) SvCUR_set(sv, arg)
-#define BSET_xpv_len(sv, arg) SvLEN_set(sv, arg)
-#define BSET_xiv(sv, arg) SvIV_set(sv, arg)
-#define BSET_xnv(sv, arg) SvNV_set(sv, arg)
-
-#define BSET_av_extend(sv, arg)        av_extend((AV*)sv, arg)
-
-#define BSET_av_push(sv, arg)  av_push((AV*)sv, arg)
-#define BSET_av_pushx(sv, arg) (AvARRAY(sv)[++AvFILLp(sv)] = arg)
-#define BSET_hv_store(sv, arg) \
-       hv_store((HV*)sv, bstate->bs_pv.pvx, bstate->bs_pv.xpv.xpv_cur, arg, 0)
-#define BSET_pv_free(p)        Safefree(p)
-
-
-#ifdef USE_ITHREADS
-
-/* copied after the code in newPMOP() */
-#define BSET_pregcomp(o, arg) \
-    STMT_START { \
-        SV* repointer; \
-       REGEXP* rx = arg ? \
-           CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv.xpv_cur, cPMOPx(o)) : \
-           Null(REGEXP*); \
-        if(av_len((AV*) PL_regex_pad[0]) > -1) { \
-            repointer = av_pop((AV*)PL_regex_pad[0]); \
-            cPMOPx(o)->op_pmoffset = SvIV(repointer); \
-            SvREPADTMP_off(repointer); \
-            sv_setiv(repointer,PTR2IV(rx)); \
-        } else { \
-            repointer = newSViv(PTR2IV(rx)); \
-            av_push(PL_regex_padav,SvREFCNT_inc(repointer)); \
-            cPMOPx(o)->op_pmoffset = av_len(PL_regex_padav); \
-            PL_regex_pad = AvARRAY(PL_regex_padav); \
-        } \
-    } STMT_END
-
-#else
-#define BSET_pregcomp(o, arg) \
-    STMT_START { \
-       PM_SETRE(((PMOP*)o), (arg ? \
-            CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv.xpv_cur, cPMOPx(o)): \
-            Null(REGEXP*))); \
-    } STMT_END
-
-#endif /* USE_THREADS */
-
-
-#define BSET_newsv(sv, arg)                            \
-           switch(arg) {                               \
-           case SVt_PVAV:                              \
-               sv = (SV*)newAV();                      \
-               break;                                  \
-           case SVt_PVHV:                              \
-               sv = (SV*)newHV();                      \
-               break;                                  \
-           default:                                    \
-               sv = newSV(0);                          \
-               SvUPGRADE(sv, (arg));                   \
-           }
-#define BSET_newsvx(sv, arg) STMT_START {              \
-           BSET_newsv(sv, (svtype)(arg &  SVTYPEMASK));                \
-           SvFLAGS(sv) = arg;                          \
-           BSET_OBJ_STOREX(sv);                        \
-       } STMT_END
-
-#define BSET_newop(o, arg)     NewOpSz(666, o, arg)
-#define BSET_newopx(o, arg) STMT_START {       \
-       register int sz = arg & 0x7f;           \
-       register OP* newop;                     \
-       BSET_newop(newop, sz);                  \
-       /* newop->op_next = o; XXX */           \
-       o = newop;                              \
-       arg >>=7;                               \
-       BSET_op_type(o, arg);                   \
-       BSET_OBJ_STOREX(o);                     \
-    } STMT_END
-
-#define BSET_newopn(o, arg) STMT_START {       \
-       OP *oldop = o;                          \
-       BSET_newop(o, arg);                     \
-       oldop->op_next = o;                     \
-    } STMT_END
-
-#define BSET_ret(foo) STMT_START {             \
-       Safefree(bstate->bs_obj_list);          \
-       return 0;                               \
-    } STMT_END
-
-#define BSET_op_pmstashpv(op, arg)     PmopSTASHPV_set(op, arg)
-
-/* 
- * stolen from toke.c: better if that was a function.
- * in toke.c there are also #ifdefs for dosish systems and i/o layers
- */
-
-#if defined(HAS_FCNTL) && defined(F_SETFD)
-#define set_clonex(fp)                         \
-       STMT_START {                            \
-           int fd = PerlIO_fileno(fp);         \
-           fcntl(fd,F_SETFD,fd >= 3);          \
-       } STMT_END
-#else
-#define set_clonex(fp)
-#endif
-
-#define BSET_data(dummy,arg)                                           \
-    STMT_START {                                                       \
-       GV *gv;                                                         \
-       char *pname = "main";                                           \
-       if (arg == 'D')                                                 \
-           pname = HvNAME(PL_curstash ? PL_curstash : PL_defstash);    \
-       gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVIO);\
-       GvMULTI_on(gv);                                                 \
-       if (!GvIO(gv))                                                  \
-           GvIOp(gv) = newIO();                                        \
-       IoIFP(GvIOp(gv)) = PL_rsfp;                                     \
-       set_clonex(PL_rsfp);                                            \
-       /* Mark this internal pseudo-handle as clean */                 \
-       IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;                              \
-       if (PL_preprocess)                                              \
-           IoTYPE(GvIOp(gv)) = IoTYPE_PIPE;                            \
-       else if ((PerlIO*)PL_rsfp == PerlIO_stdin())                    \
-           IoTYPE(GvIOp(gv)) = IoTYPE_STD;                             \
-       else                                                            \
-           IoTYPE(GvIOp(gv)) = IoTYPE_RDONLY;                          \
-       Safefree(bstate->bs_obj_list);                                  \
-       return 1;                                                       \
-    } STMT_END
-
-/* stolen from op.c */
-#define BSET_load_glob(foo, gv)                                                \
-    STMT_START {                                                       \
-        GV *glob_gv;                                                   \
-        ENTER;                                                         \
-        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,                  \
-                newSVpvn("File::Glob", 10), Nullsv, Nullsv, Nullsv);   \
-        glob_gv = gv_fetchpv("File::Glob::csh_glob", FALSE, SVt_PVCV); \
-        GvCV(gv) = GvCV(glob_gv);                                      \
-        SvREFCNT_inc((SV*)GvCV(gv));                                   \
-        GvIMPORTED_CV_on(gv);                                          \
-        LEAVE;                                                         \
-    } STMT_END
-
-/*
- * Kludge special-case workaround for OP_MAPSTART
- * which needs the ppaddr for OP_GREPSTART. Blech.
- */
-#define BSET_op_type(o, arg) STMT_START {      \
-       o->op_type = arg;                       \
-       if (arg == OP_MAPSTART)                 \
-           arg = OP_GREPSTART;                 \
-       o->op_ppaddr = PL_ppaddr[arg];          \
-    } STMT_END
-#define BSET_op_ppaddr(o, arg) Perl_croak(aTHX_ "op_ppaddr not yet implemented")
-#define BSET_curpad(pad, arg) STMT_START {     \
-       PL_comppad = (AV *)arg;                 \
-       pad = AvARRAY(arg);                     \
-    } STMT_END
-
-#ifdef USE_ITHREADS
-#define BSET_cop_file(cop, arg)                CopFILE_set(cop,arg)
-#define BSET_cop_stashpv(cop, arg)     CopSTASHPV_set(cop,arg)
-#else
-/* this works now that Sarathy's changed the CopFILE_set macro to do the SvREFCNT_inc()
-       -- BKS 6-2-2000 */
-/* that really meant the actual CopFILEGV_set */
-#define BSET_cop_filegv(cop, arg)      CopFILEGV_set(cop,arg)
-#define BSET_cop_stash(cop,arg)                CopSTASH_set(cop,(HV*)arg)
-#endif
-
-/* this is simply stolen from the code in newATTRSUB() */
-#define BSET_push_begin(ary,cv)                                \
-       STMT_START {                                    \
-            I32 oldscope = PL_scopestack_ix;           \
-            ENTER;                                     \
-            SAVECOPFILE(&PL_compiling);                        \
-            SAVECOPLINE(&PL_compiling);                        \
-            if (!PL_beginav)                           \
-                PL_beginav = newAV();                  \
-            av_push(PL_beginav, (SV*)cv);              \
-           GvCV(CvGV(cv)) = 0;               /* cv has been hijacked */\
-            call_list(oldscope, PL_beginav);           \
-            PL_curcop = &PL_compiling;                 \
-            CopHINTS_set(&PL_compiling, PL_hints);     \
-            LEAVE;                                     \
-       } STMT_END
-#define BSET_push_init(ary,cv)                         \
-       STMT_START {                                    \
-           av_unshift((PL_initav ? PL_initav :         \
-               (PL_initav = newAV(), PL_initav)), 1);  \
-           av_store(PL_initav, 0, cv);                 \
-       } STMT_END
-#define BSET_push_end(ary,cv)                          \
-       STMT_START {                                    \
-           av_unshift((PL_endav ? PL_endav :           \
-           (PL_endav = newAV(), PL_endav)), 1);        \
-           av_store(PL_endav, 0, cv);                  \
-       } STMT_END
-#define BSET_OBJ_STORE(obj, ix)                        \
-       ((I32)ix > bstate->bs_obj_list_fill ?   \
-        bset_obj_store(aTHX_ bstate, obj, (I32)ix) : \
-        (bstate->bs_obj_list[ix] = obj),       \
-        bstate->bs_ix = ix+1)
-#define BSET_OBJ_STOREX(obj)                   \
-       (bstate->bs_ix > bstate->bs_obj_list_fill ?     \
-        bset_obj_store(aTHX_ bstate, obj, bstate->bs_ix) : \
-        (bstate->bs_obj_list[bstate->bs_ix] = obj),    \
-        bstate->bs_ix++)
-
-#define BSET_signal(cv, name)                                          \
-       mg_set(*hv_store(GvHV(gv_fetchpv("SIG", TRUE, SVt_PVHV)),       \
-               name, strlen(name), cv, 0))
-
-#define BSET_xhv_name(hv, name)        hv_name_set((HV*)hv, name, strlen(name), 0)
-#define BSET_cop_arybase(c, b) CopARYBASE_set(c, b)
-#define BSET_cop_warnings(c, w) \
-       STMT_START {                                                    \
-           if (specialWARN((STRLEN *)w)) {                             \
-               c->cop_warnings = (STRLEN *)w;                          \
-           } else {                                                    \
-               STRLEN len;                                             \
-               const char *const p = SvPV_const(w, len);               \
-               c->cop_warnings =                                       \
-                   Perl_new_warnings_bitfield(aTHX_ NULL, p, len);     \
-               SvREFCNT_dec(w);                                        \
-           }                                                           \
-       } STMT_END
-#define BSET_gp_file(gv, file) \
-       STMT_START {                                                    \
-           STRLEN len = strlen(file);                                  \
-           U32 hash;                                                   \
-           PERL_HASH(hash, file, len);                                 \
-           if(GvFILE_HEK(gv)) {                                        \
-               Perl_unshare_hek(aTHX_ GvFILE_HEK(gv));                 \
-           }                                                           \
-           GvGP(gv)->gp_file_hek = share_hek(file, len, hash);         \
-           Safefree(file);                                             \
-       } STMT_END
-
-/* NOTE: the bytecode header only sanity-checks the bytecode. If a script cares about
- * what version of Perl it's being called under, it should do a 'use 5.006_001' or
- * equivalent. However, since the header includes checks requiring an exact match in
- * ByteLoader versions (we can't guarantee forward compatibility), you don't 
- * need to specify one:
- *     use ByteLoader;
- * is all you need.
- *     -- BKS, June 2000
-*/
-
-#define HEADER_FAIL(f) \
-       Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f)
-#define HEADER_FAIL1(f, arg1)  \
-       Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f, arg1)
-#define HEADER_FAIL2(f, arg1, arg2)    \
-       Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f, arg1, arg2)
-
-#define BYTECODE_HEADER_CHECK                                  \
-       STMT_START {                                            \
-           U32 sz = 0;                                         \
-           strconst str;                                       \
-                                                               \
-           BGET_U32(sz); /* Magic: 'PLBC' */                   \
-           if (sz != 0x43424c50) {                             \
-               HEADER_FAIL1("bad magic (want 0x43424c50, got %#x)", (int)sz);          \
-           }                                                   \
-           BGET_strconst(str); /* archname */                  \
-           if (strNE(str, ARCHNAME)) {                         \
-               HEADER_FAIL2("wrong architecture (want %s, you have %s)",str,ARCHNAME); \
-           }                                                   \
-           BGET_strconst(str); /* ByteLoader version */        \
-           if (strNE(str, VERSION)) {                          \
-               HEADER_FAIL2("mismatched ByteLoader versions (want %s, you have %s)",   \
-                       str, VERSION);                          \
-           }                                                   \
-           BGET_U32(sz); /* ivsize */                          \
-           if (sz != IVSIZE) {                                 \
-               HEADER_FAIL("different IVSIZE");                \
-           }                                                   \
-           BGET_U32(sz); /* ptrsize */                         \
-           if (sz != PTRSIZE) {                                \
-               HEADER_FAIL("different PTRSIZE");               \
-           }                                                   \
-       } STMT_END
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
deleted file mode 100644 (file)
index 0c491c0..0000000
+++ /dev/null
@@ -1,1121 +0,0 @@
-/* -*- buffer-read-only: t -*-
- *
- *      Copyright (c) 1996-1999 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.
- *
- */
-/*
- * This file is autogenerated from bytecode.pl. Changes made here will be lost.
- */
-
-#define PERL_NO_GET_CONTEXT
-#include "EXTERN.h"
-#include "perl.h"
-#define NO_XSLOCKS
-#include "XSUB.h"
-
-#include "byterun.h"
-#include "bytecode.h"
-
-
-static const int optype_size[] = {
-    sizeof(OP),
-    sizeof(UNOP),
-    sizeof(BINOP),
-    sizeof(LOGOP),
-    sizeof(LISTOP),
-    sizeof(PMOP),
-    sizeof(SVOP),
-    sizeof(PADOP),
-    sizeof(PVOP),
-    sizeof(LOOP),
-    sizeof(COP)
-};
-
-void *
-bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix)
-{
-    if (ix > bstate->bs_obj_list_fill) {
-       Renew(bstate->bs_obj_list, ix + 32, void*);
-       bstate->bs_obj_list_fill = ix + 31;
-    }
-    bstate->bs_obj_list[ix] = obj;
-    return obj;
-}
-
-int
-byterun(pTHX_ register struct byteloader_state *bstate)
-{
-    dVAR;
-    register int insn;
-    U32 ix;
-    SV *specialsv_list[7];
-
-    BYTECODE_HEADER_CHECK;     /* croak if incorrect platform */
-    Newx(bstate->bs_obj_list, 32, void*); /* set op objlist */
-    bstate->bs_obj_list_fill = 31;
-    bstate->bs_obj_list[0] = NULL; /* first is always Null */
-    bstate->bs_ix = 1;
-
-    specialsv_list[0] = Nullsv;
-    specialsv_list[1] = &PL_sv_undef;
-    specialsv_list[2] = &PL_sv_yes;
-    specialsv_list[3] = &PL_sv_no;
-    specialsv_list[4] = (SV*)pWARN_ALL;
-    specialsv_list[5] = (SV*)pWARN_NONE;
-    specialsv_list[6] = (SV*)pWARN_STD;
-
-    while ((insn = BGET_FGETC()) != EOF) {
-       switch (insn) {
-         case INSN_COMMENT:            /* 35 */
-           {
-               comment_t arg;
-               BGET_comment_t(arg);
-               arg = arg;
-               break;
-           }
-         case INSN_NOP:                /* 10 */
-           {
-               break;
-           }
-         case INSN_RET:                /* 0 */
-           {
-               BSET_ret(none);
-               break;
-           }
-         case INSN_LDSV:               /* 1 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               bstate->bs_sv = arg;
-               break;
-           }
-         case INSN_LDOP:               /* 2 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               PL_op = arg;
-               break;
-           }
-         case INSN_STSV:               /* 3 */
-           {
-               U32 arg;
-               BGET_U32(arg);
-               BSET_OBJ_STORE(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_STOP:               /* 4 */
-           {
-               U32 arg;
-               BGET_U32(arg);
-               BSET_OBJ_STORE(PL_op, arg);
-               break;
-           }
-         case INSN_STPV:               /* 5 */
-           {
-               U32 arg;
-               BGET_U32(arg);
-               BSET_stpv(bstate->bs_pv.pvx, arg);
-               break;
-           }
-         case INSN_LDSPECSV:           /* 6 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               BSET_ldspecsv(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_LDSPECSVX:          /* 7 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               BSET_ldspecsvx(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_NEWSV:              /* 8 */
-           {
-               svtype arg;
-               BGET_svtype(arg);
-               BSET_newsv(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_NEWSVX:             /* 9 */
-           {
-               svtype arg;
-               BGET_svtype(arg);
-               BSET_newsvx(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_NEWOP:              /* 11 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               BSET_newop(PL_op, arg);
-               break;
-           }
-         case INSN_NEWOPX:             /* 12 */
-           {
-               U16 arg;
-               BGET_U16(arg);
-               BSET_newopx(PL_op, arg);
-               break;
-           }
-         case INSN_NEWOPN:             /* 13 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               BSET_newopn(PL_op, arg);
-               break;
-           }
-         case INSN_NEWPV:              /* 14 */
-           {
-               PV arg;
-               BGET_PV(arg);
-               break;
-           }
-         case INSN_PV_CUR:             /* 15 */
-           {
-               STRLEN arg;
-               BGET_PADOFFSET(arg);
-               bstate->bs_pv.xpv.xpv_cur = arg;
-               break;
-           }
-         case INSN_PV_FREE:            /* 16 */
-           {
-               BSET_pv_free(bstate->bs_pv.pvx);
-               break;
-           }
-         case INSN_SV_UPGRADE:         /* 17 */
-           {
-               svtype arg;
-               BGET_svtype(arg);
-               BSET_sv_upgrade(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_SV_REFCNT:          /* 18 */
-           {
-               U32 arg;
-               BGET_U32(arg);
-               SvREFCNT(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_SV_REFCNT_ADD:              /* 19 */
-           {
-               I32 arg;
-               BGET_I32(arg);
-               BSET_sv_refcnt_add(SvREFCNT(bstate->bs_sv), arg);
-               break;
-           }
-         case INSN_SV_FLAGS:           /* 20 */
-           {
-               U32 arg;
-               BGET_U32(arg);
-               SvFLAGS(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XRV:                /* 21 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_xrv(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_XPV:                /* 22 */
-           {
-               BSET_xpv(bstate->bs_sv);
-               break;
-           }
-         case INSN_XPV_CUR:            /* 23 */
-           {
-               STRLEN arg;
-               BGET_PADOFFSET(arg);
-               BSET_xpv_cur(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_XPV_LEN:            /* 24 */
-           {
-               STRLEN arg;
-               BGET_PADOFFSET(arg);
-               BSET_xpv_len(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_XIV:                /* 25 */
-           {
-               IV arg;
-               BGET_IV(arg);
-               BSET_xiv(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_XNV:                /* 26 */
-           {
-               NV arg;
-               BGET_NV(arg);
-               BSET_xnv(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_XLV_TARGOFF:                /* 27 */
-           {
-               STRLEN arg;
-               BGET_PADOFFSET(arg);
-               LvTARGOFF(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XLV_TARGLEN:                /* 28 */
-           {
-               STRLEN arg;
-               BGET_PADOFFSET(arg);
-               LvTARGLEN(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XLV_TARG:           /* 29 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               LvTARG(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XLV_TYPE:           /* 30 */
-           {
-               char arg;
-               BGET_U8(arg);
-               LvTYPE(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XBM_USEFUL:         /* 31 */
-           {
-               I32 arg;
-               BGET_I32(arg);
-               BmUSEFUL(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XBM_PREVIOUS:               /* 32 */
-           {
-               U16 arg;
-               BGET_U16(arg);
-               BmPREVIOUS(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XBM_RARE:           /* 33 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               BmRARE(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XFM_LINES:          /* 34 */
-           {
-               IV arg;
-               BGET_IV(arg);
-               FmLINES(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_LINES:          /* 36 */
-           {
-               IV arg;
-               BGET_IV(arg);
-               IoLINES(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_PAGE:           /* 37 */
-           {
-               IV arg;
-               BGET_IV(arg);
-               IoPAGE(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_PAGE_LEN:               /* 38 */
-           {
-               IV arg;
-               BGET_IV(arg);
-               IoPAGE_LEN(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_LINES_LEFT:             /* 39 */
-           {
-               IV arg;
-               BGET_IV(arg);
-               IoLINES_LEFT(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_TOP_NAME:               /* 40 */
-           {
-               pvindex arg;
-               BGET_pvindex(arg);
-               IoTOP_NAME(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_TOP_GV:         /* 41 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&IoTOP_GV(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_FMT_NAME:               /* 42 */
-           {
-               pvindex arg;
-               BGET_pvindex(arg);
-               IoFMT_NAME(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_FMT_GV:         /* 43 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&IoFMT_GV(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_BOTTOM_NAME:            /* 44 */
-           {
-               pvindex arg;
-               BGET_pvindex(arg);
-               IoBOTTOM_NAME(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_BOTTOM_GV:              /* 45 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&IoBOTTOM_GV(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_SUBPROCESS:             /* 46 */
-           {
-               short arg;
-               BGET_U16(arg);
-               IoSUBPROCESS(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_TYPE:           /* 47 */
-           {
-               char arg;
-               BGET_U8(arg);
-               IoTYPE(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XIO_FLAGS:          /* 48 */
-           {
-               char arg;
-               BGET_U8(arg);
-               IoFLAGS(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XCV_XSUBANY:                /* 49 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&CvXSUBANY(bstate->bs_sv).any_ptr = arg;
-               break;
-           }
-         case INSN_XCV_STASH:          /* 50 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&CvSTASH(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XCV_START:          /* 51 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               CvSTART(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XCV_ROOT:           /* 52 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               CvROOT(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XCV_GV:             /* 53 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&CvGV(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XCV_FILE:           /* 54 */
-           {
-               pvindex arg;
-               BGET_pvindex(arg);
-               CvFILE(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XCV_DEPTH:          /* 55 */
-           {
-               long arg;
-               BGET_long(arg);
-               CvDEPTH(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XCV_PADLIST:                /* 56 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&CvPADLIST(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XCV_OUTSIDE:                /* 57 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&CvOUTSIDE(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XCV_OUTSIDE_SEQ:            /* 58 */
-           {
-               U32 arg;
-               BGET_U32(arg);
-               CvOUTSIDE_SEQ(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XCV_FLAGS:          /* 59 */
-           {
-               U16 arg;
-               BGET_U16(arg);
-               CvFLAGS(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_AV_EXTEND:          /* 60 */
-           {
-               SSize_t arg;
-               BGET_PADOFFSET(arg);
-               BSET_av_extend(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_AV_PUSHX:           /* 61 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_av_pushx(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_AV_PUSH:            /* 62 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_av_push(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_XAV_FILL:           /* 63 */
-           {
-               SSize_t arg;
-               BGET_PADOFFSET(arg);
-               AvFILLp(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XAV_MAX:            /* 64 */
-           {
-               SSize_t arg;
-               BGET_PADOFFSET(arg);
-               AvMAX(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XHV_RITER:          /* 65 */
-           {
-               I32 arg;
-               BGET_I32(arg);
-               HvRITER(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_XHV_NAME:           /* 66 */
-           {
-               pvindex arg;
-               BGET_pvindex(arg);
-               BSET_xhv_name(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_HV_STORE:           /* 67 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_hv_store(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_SV_MAGIC:           /* 68 */
-           {
-               char arg;
-               BGET_U8(arg);
-               BSET_sv_magic(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_MG_OBJ:             /* 69 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               SvMAGIC(bstate->bs_sv)->mg_obj = arg;
-               break;
-           }
-         case INSN_MG_PRIVATE:         /* 70 */
-           {
-               U16 arg;
-               BGET_U16(arg);
-               SvMAGIC(bstate->bs_sv)->mg_private = arg;
-               break;
-           }
-         case INSN_MG_FLAGS:           /* 71 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               SvMAGIC(bstate->bs_sv)->mg_flags = arg;
-               break;
-           }
-         case INSN_MG_NAME:            /* 72 */
-           {
-               pvcontents arg;
-               BGET_pvcontents(arg);
-               BSET_mg_name(SvMAGIC(bstate->bs_sv), arg);
-               break;
-           }
-         case INSN_MG_NAMEX:           /* 73 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_mg_namex(SvMAGIC(bstate->bs_sv), arg);
-               break;
-           }
-         case INSN_XMG_STASH:          /* 74 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_xmg_stash(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_GV_FETCHPV:         /* 75 */
-           {
-               strconst arg;
-               BGET_strconst(arg);
-               BSET_gv_fetchpv(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_GV_FETCHPVX:                /* 76 */
-           {
-               strconst arg;
-               BGET_strconst(arg);
-               BSET_gv_fetchpvx(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_GV_STASHPV:         /* 77 */
-           {
-               strconst arg;
-               BGET_strconst(arg);
-               BSET_gv_stashpv(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_GV_STASHPVX:                /* 78 */
-           {
-               strconst arg;
-               BGET_strconst(arg);
-               BSET_gv_stashpvx(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_GP_SV:              /* 79 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               GvSV(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_GP_REFCNT:          /* 80 */
-           {
-               U32 arg;
-               BGET_U32(arg);
-               GvREFCNT(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_GP_REFCNT_ADD:              /* 81 */
-           {
-               I32 arg;
-               BGET_I32(arg);
-               BSET_gp_refcnt_add(GvREFCNT(bstate->bs_sv), arg);
-               break;
-           }
-         case INSN_GP_AV:              /* 82 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&GvAV(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_GP_HV:              /* 83 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&GvHV(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_GP_CV:              /* 84 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&GvCV(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_GP_FILE:            /* 85 */
-           {
-               pvindex arg;
-               BGET_pvindex(arg);
-               BSET_gp_file(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_GP_IO:              /* 86 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&GvIOp(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_GP_FORM:            /* 87 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&GvFORM(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_GP_CVGEN:           /* 88 */
-           {
-               U32 arg;
-               BGET_U32(arg);
-               GvCVGEN(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_GP_LINE:            /* 89 */
-           {
-               line_t arg;
-               BGET_U32(arg);
-               GvLINE(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_GP_SHARE:           /* 90 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_gp_share(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_XGV_FLAGS:          /* 91 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               GvFLAGS(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_OP_NEXT:            /* 92 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               PL_op->op_next = arg;
-               break;
-           }
-         case INSN_OP_SIBLING:         /* 93 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               PL_op->op_sibling = arg;
-               break;
-           }
-         case INSN_OP_PPADDR:          /* 94 */
-           {
-               strconst arg;
-               BGET_strconst(arg);
-               BSET_op_ppaddr(PL_op->op_ppaddr, arg);
-               break;
-           }
-         case INSN_OP_TARG:            /* 95 */
-           {
-               PADOFFSET arg;
-               BGET_PADOFFSET(arg);
-               PL_op->op_targ = arg;
-               break;
-           }
-         case INSN_OP_TYPE:            /* 96 */
-           {
-               OPCODE arg;
-               BGET_U16(arg);
-               BSET_op_type(PL_op, arg);
-               break;
-           }
-         case INSN_OP_OPT:             /* 97 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               PL_op->op_opt = arg;
-               break;
-           }
-         case INSN_OP_STATIC:          /* 98 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               PL_op->op_static = arg;
-               break;
-           }
-         case INSN_OP_FLAGS:           /* 99 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               PL_op->op_flags = arg;
-               break;
-           }
-         case INSN_OP_PRIVATE:         /* 100 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               PL_op->op_private = arg;
-               break;
-           }
-         case INSN_OP_FIRST:           /* 101 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               cUNOP->op_first = arg;
-               break;
-           }
-         case INSN_OP_LAST:            /* 102 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               cBINOP->op_last = arg;
-               break;
-           }
-         case INSN_OP_OTHER:           /* 103 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               cLOGOP->op_other = arg;
-               break;
-           }
-         case INSN_OP_PMREPLROOT:              /* 104 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               cPMOP->op_pmreplroot = arg;
-               break;
-           }
-         case INSN_OP_PMREPLSTART:             /* 105 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               cPMOP->op_pmreplstart = arg;
-               break;
-           }
-         case INSN_OP_PMNEXT:          /* 106 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               *(OP**)&cPMOP->op_pmnext = arg;
-               break;
-           }
-#ifdef USE_ITHREADS
-         case INSN_OP_PMSTASHPV:               /* 107 */
-           {
-               pvindex arg;
-               BGET_pvindex(arg);
-               BSET_op_pmstashpv(cPMOP, arg);
-               break;
-           }
-         case INSN_OP_PMREPLROOTPO:            /* 108 */
-           {
-               PADOFFSET arg;
-               BGET_PADOFFSET(arg);
-               cPMOP->op_pmreplroot = (OP*)arg;
-               break;
-           }
-#else
-         case INSN_OP_PMSTASH:         /* 109 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&cPMOP->op_pmstash = arg;
-               break;
-           }
-         case INSN_OP_PMREPLROOTGV:            /* 110 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&cPMOP->op_pmreplroot = arg;
-               break;
-           }
-#endif
-         case INSN_PREGCOMP:           /* 111 */
-           {
-               pvcontents arg;
-               BGET_pvcontents(arg);
-               BSET_pregcomp(PL_op, arg);
-               break;
-           }
-         case INSN_OP_PMFLAGS:         /* 112 */
-           {
-               U16 arg;
-               BGET_U16(arg);
-               cPMOP->op_pmflags = arg;
-               break;
-           }
-         case INSN_OP_PMPERMFLAGS:             /* 113 */
-           {
-               U16 arg;
-               BGET_U16(arg);
-               cPMOP->op_pmpermflags = arg;
-               break;
-           }
-         case INSN_OP_PMDYNFLAGS:              /* 114 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               cPMOP->op_pmdynflags = arg;
-               break;
-           }
-         case INSN_OP_SV:              /* 115 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               cSVOP->op_sv = arg;
-               break;
-           }
-         case INSN_OP_PADIX:           /* 116 */
-           {
-               PADOFFSET arg;
-               BGET_PADOFFSET(arg);
-               cPADOP->op_padix = arg;
-               break;
-           }
-         case INSN_OP_PV:              /* 117 */
-           {
-               pvcontents arg;
-               BGET_pvcontents(arg);
-               cPVOP->op_pv = arg;
-               break;
-           }
-         case INSN_OP_PV_TR:           /* 118 */
-           {
-               op_tr_array arg;
-               BGET_op_tr_array(arg);
-               cPVOP->op_pv = arg;
-               break;
-           }
-         case INSN_OP_REDOOP:          /* 119 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               cLOOP->op_redoop = arg;
-               break;
-           }
-         case INSN_OP_NEXTOP:          /* 120 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               cLOOP->op_nextop = arg;
-               break;
-           }
-         case INSN_OP_LASTOP:          /* 121 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               cLOOP->op_lastop = arg;
-               break;
-           }
-         case INSN_COP_LABEL:          /* 122 */
-           {
-               pvindex arg;
-               BGET_pvindex(arg);
-               cCOP->cop_label = arg;
-               break;
-           }
-#ifdef USE_ITHREADS
-         case INSN_COP_STASHPV:                /* 123 */
-           {
-               pvindex arg;
-               BGET_pvindex(arg);
-               BSET_cop_stashpv(cCOP, arg);
-               break;
-           }
-         case INSN_COP_FILE:           /* 124 */
-           {
-               pvindex arg;
-               BGET_pvindex(arg);
-               BSET_cop_file(cCOP, arg);
-               break;
-           }
-#else
-         case INSN_COP_STASH:          /* 125 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_cop_stash(cCOP, arg);
-               break;
-           }
-         case INSN_COP_FILEGV:         /* 126 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_cop_filegv(cCOP, arg);
-               break;
-           }
-#endif
-         case INSN_COP_SEQ:            /* 127 */
-           {
-               U32 arg;
-               BGET_U32(arg);
-               cCOP->cop_seq = arg;
-               break;
-           }
-         case INSN_COP_ARYBASE:                /* 128 */
-           {
-               I32 arg;
-               BGET_I32(arg);
-               BSET_cop_arybase(cCOP, arg);
-               break;
-           }
-         case INSN_COP_LINE:           /* 129 */
-           {
-               line_t arg;
-               BGET_U32(arg);
-               cCOP->cop_line = arg;
-               break;
-           }
-         case INSN_COP_WARNINGS:               /* 130 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_cop_warnings(cCOP, arg);
-               break;
-           }
-         case INSN_MAIN_START:         /* 131 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               PL_main_start = arg;
-               break;
-           }
-         case INSN_MAIN_ROOT:          /* 132 */
-           {
-               opindex arg;
-               BGET_opindex(arg);
-               PL_main_root = arg;
-               break;
-           }
-         case INSN_MAIN_CV:            /* 133 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&PL_main_cv = arg;
-               break;
-           }
-         case INSN_CURPAD:             /* 134 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_curpad(PL_curpad, arg);
-               break;
-           }
-         case INSN_PUSH_BEGIN:         /* 135 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_push_begin(PL_beginav, arg);
-               break;
-           }
-         case INSN_PUSH_INIT:          /* 136 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_push_init(PL_initav, arg);
-               break;
-           }
-         case INSN_PUSH_END:           /* 137 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_push_end(PL_endav, arg);
-               break;
-           }
-         case INSN_CURSTASH:           /* 138 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&PL_curstash = arg;
-               break;
-           }
-         case INSN_DEFSTASH:           /* 139 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&PL_defstash = arg;
-               break;
-           }
-         case INSN_DATA:               /* 140 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               BSET_data(none, arg);
-               break;
-           }
-         case INSN_INCAV:              /* 141 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&GvAV(PL_incgv) = arg;
-               break;
-           }
-         case INSN_LOAD_GLOB:          /* 142 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               BSET_load_glob(none, arg);
-               break;
-           }
-#ifdef USE_ITHREADS
-         case INSN_REGEX_PADAV:                /* 143 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&PL_regex_padav = arg;
-               break;
-           }
-#endif
-         case INSN_DOWARN:             /* 144 */
-           {
-               U8 arg;
-               BGET_U8(arg);
-               PL_dowarn = arg;
-               break;
-           }
-         case INSN_COMPPAD_NAME:               /* 145 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&PL_comppad_name = arg;
-               break;
-           }
-         case INSN_XGV_STASH:          /* 146 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               *(SV**)&GvSTASH(bstate->bs_sv) = arg;
-               break;
-           }
-         case INSN_SIGNAL:             /* 147 */
-           {
-               strconst arg;
-               BGET_strconst(arg);
-               BSET_signal(bstate->bs_sv, arg);
-               break;
-           }
-         case INSN_FORMFEED:           /* 148 */
-           {
-               svindex arg;
-               BGET_svindex(arg);
-               PL_formfeed = arg;
-               break;
-           }
-         default:
-           Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn);
-           /* NOTREACHED */
-       }
-    }
-    return 0;
-}
-
-/* ex: set ro: */
diff --git a/ext/ByteLoader/byterun.h b/ext/ByteLoader/byterun.h
deleted file mode 100644 (file)
index 75c1ba0..0000000
+++ /dev/null
@@ -1,204 +0,0 @@
-/* -*- buffer-read-only: t -*-
- *
- *      Copyright (c) 1996-1999 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.
- *
- */
-/*
- * This file is autogenerated from bytecode.pl. Changes made here will be lost.
- */
-struct byteloader_fdata {
-    SV *datasv;
-    int next_out;
-    int        idx;
-};
-
-struct byteloader_pv_state {
-    char                       *pvx;
-    XPV                                xpv;
-};
-
-struct byteloader_state {
-    struct byteloader_fdata    *bs_fdata;
-    SV                         *bs_sv;
-    void                       **bs_obj_list;
-    int                                bs_obj_list_fill;
-    int                                bs_ix;
-    struct byteloader_pv_state bs_pv;
-    int                                bs_iv_overflows;
-};
-
-int bl_getc(struct byteloader_fdata *);
-int bl_read(struct byteloader_fdata *, char *, size_t, size_t);
-extern int byterun(pTHX_ struct byteloader_state *);
-
-enum {
-    INSN_RET,                  /* 0 */
-    INSN_LDSV,                 /* 1 */
-    INSN_LDOP,                 /* 2 */
-    INSN_STSV,                 /* 3 */
-    INSN_STOP,                 /* 4 */
-    INSN_STPV,                 /* 5 */
-    INSN_LDSPECSV,                     /* 6 */
-    INSN_LDSPECSVX,                    /* 7 */
-    INSN_NEWSV,                        /* 8 */
-    INSN_NEWSVX,                       /* 9 */
-    INSN_NOP,                  /* 10 */
-    INSN_NEWOP,                        /* 11 */
-    INSN_NEWOPX,                       /* 12 */
-    INSN_NEWOPN,                       /* 13 */
-    INSN_NEWPV,                        /* 14 */
-    INSN_PV_CUR,                       /* 15 */
-    INSN_PV_FREE,                      /* 16 */
-    INSN_SV_UPGRADE,                   /* 17 */
-    INSN_SV_REFCNT,                    /* 18 */
-    INSN_SV_REFCNT_ADD,                        /* 19 */
-    INSN_SV_FLAGS,                     /* 20 */
-    INSN_XRV,                  /* 21 */
-    INSN_XPV,                  /* 22 */
-    INSN_XPV_CUR,                      /* 23 */
-    INSN_XPV_LEN,                      /* 24 */
-    INSN_XIV,                  /* 25 */
-    INSN_XNV,                  /* 26 */
-    INSN_XLV_TARGOFF,                  /* 27 */
-    INSN_XLV_TARGLEN,                  /* 28 */
-    INSN_XLV_TARG,                     /* 29 */
-    INSN_XLV_TYPE,                     /* 30 */
-    INSN_XBM_USEFUL,                   /* 31 */
-    INSN_XBM_PREVIOUS,                 /* 32 */
-    INSN_XBM_RARE,                     /* 33 */
-    INSN_XFM_LINES,                    /* 34 */
-    INSN_COMMENT,                      /* 35 */
-    INSN_XIO_LINES,                    /* 36 */
-    INSN_XIO_PAGE,                     /* 37 */
-    INSN_XIO_PAGE_LEN,                 /* 38 */
-    INSN_XIO_LINES_LEFT,                       /* 39 */
-    INSN_XIO_TOP_NAME,                 /* 40 */
-    INSN_XIO_TOP_GV,                   /* 41 */
-    INSN_XIO_FMT_NAME,                 /* 42 */
-    INSN_XIO_FMT_GV,                   /* 43 */
-    INSN_XIO_BOTTOM_NAME,                      /* 44 */
-    INSN_XIO_BOTTOM_GV,                        /* 45 */
-    INSN_XIO_SUBPROCESS,                       /* 46 */
-    INSN_XIO_TYPE,                     /* 47 */
-    INSN_XIO_FLAGS,                    /* 48 */
-    INSN_XCV_XSUBANY,                  /* 49 */
-    INSN_XCV_STASH,                    /* 50 */
-    INSN_XCV_START,                    /* 51 */
-    INSN_XCV_ROOT,                     /* 52 */
-    INSN_XCV_GV,                       /* 53 */
-    INSN_XCV_FILE,                     /* 54 */
-    INSN_XCV_DEPTH,                    /* 55 */
-    INSN_XCV_PADLIST,                  /* 56 */
-    INSN_XCV_OUTSIDE,                  /* 57 */
-    INSN_XCV_OUTSIDE_SEQ,                      /* 58 */
-    INSN_XCV_FLAGS,                    /* 59 */
-    INSN_AV_EXTEND,                    /* 60 */
-    INSN_AV_PUSHX,                     /* 61 */
-    INSN_AV_PUSH,                      /* 62 */
-    INSN_XAV_FILL,                     /* 63 */
-    INSN_XAV_MAX,                      /* 64 */
-    INSN_XHV_RITER,                    /* 65 */
-    INSN_XHV_NAME,                     /* 66 */
-    INSN_HV_STORE,                     /* 67 */
-    INSN_SV_MAGIC,                     /* 68 */
-    INSN_MG_OBJ,                       /* 69 */
-    INSN_MG_PRIVATE,                   /* 70 */
-    INSN_MG_FLAGS,                     /* 71 */
-    INSN_MG_NAME,                      /* 72 */
-    INSN_MG_NAMEX,                     /* 73 */
-    INSN_XMG_STASH,                    /* 74 */
-    INSN_GV_FETCHPV,                   /* 75 */
-    INSN_GV_FETCHPVX,                  /* 76 */
-    INSN_GV_STASHPV,                   /* 77 */
-    INSN_GV_STASHPVX,                  /* 78 */
-    INSN_GP_SV,                        /* 79 */
-    INSN_GP_REFCNT,                    /* 80 */
-    INSN_GP_REFCNT_ADD,                        /* 81 */
-    INSN_GP_AV,                        /* 82 */
-    INSN_GP_HV,                        /* 83 */
-    INSN_GP_CV,                        /* 84 */
-    INSN_GP_FILE,                      /* 85 */
-    INSN_GP_IO,                        /* 86 */
-    INSN_GP_FORM,                      /* 87 */
-    INSN_GP_CVGEN,                     /* 88 */
-    INSN_GP_LINE,                      /* 89 */
-    INSN_GP_SHARE,                     /* 90 */
-    INSN_XGV_FLAGS,                    /* 91 */
-    INSN_OP_NEXT,                      /* 92 */
-    INSN_OP_SIBLING,                   /* 93 */
-    INSN_OP_PPADDR,                    /* 94 */
-    INSN_OP_TARG,                      /* 95 */
-    INSN_OP_TYPE,                      /* 96 */
-    INSN_OP_OPT,                       /* 97 */
-    INSN_OP_STATIC,                    /* 98 */
-    INSN_OP_FLAGS,                     /* 99 */
-    INSN_OP_PRIVATE,                   /* 100 */
-    INSN_OP_FIRST,                     /* 101 */
-    INSN_OP_LAST,                      /* 102 */
-    INSN_OP_OTHER,                     /* 103 */
-    INSN_OP_PMREPLROOT,                        /* 104 */
-    INSN_OP_PMREPLSTART,                       /* 105 */
-    INSN_OP_PMNEXT,                    /* 106 */
-    INSN_OP_PMSTASHPV,                 /* 107 */
-    INSN_OP_PMREPLROOTPO,                      /* 108 */
-    INSN_OP_PMSTASH,                   /* 109 */
-    INSN_OP_PMREPLROOTGV,                      /* 110 */
-    INSN_PREGCOMP,                     /* 111 */
-    INSN_OP_PMFLAGS,                   /* 112 */
-    INSN_OP_PMPERMFLAGS,                       /* 113 */
-    INSN_OP_PMDYNFLAGS,                        /* 114 */
-    INSN_OP_SV,                        /* 115 */
-    INSN_OP_PADIX,                     /* 116 */
-    INSN_OP_PV,                        /* 117 */
-    INSN_OP_PV_TR,                     /* 118 */
-    INSN_OP_REDOOP,                    /* 119 */
-    INSN_OP_NEXTOP,                    /* 120 */
-    INSN_OP_LASTOP,                    /* 121 */
-    INSN_COP_LABEL,                    /* 122 */
-    INSN_COP_STASHPV,                  /* 123 */
-    INSN_COP_FILE,                     /* 124 */
-    INSN_COP_STASH,                    /* 125 */
-    INSN_COP_FILEGV,                   /* 126 */
-    INSN_COP_SEQ,                      /* 127 */
-    INSN_COP_ARYBASE,                  /* 128 */
-    INSN_COP_LINE,                     /* 129 */
-    INSN_COP_WARNINGS,                 /* 130 */
-    INSN_MAIN_START,                   /* 131 */
-    INSN_MAIN_ROOT,                    /* 132 */
-    INSN_MAIN_CV,                      /* 133 */
-    INSN_CURPAD,                       /* 134 */
-    INSN_PUSH_BEGIN,                   /* 135 */
-    INSN_PUSH_INIT,                    /* 136 */
-    INSN_PUSH_END,                     /* 137 */
-    INSN_CURSTASH,                     /* 138 */
-    INSN_DEFSTASH,                     /* 139 */
-    INSN_DATA,                 /* 140 */
-    INSN_INCAV,                        /* 141 */
-    INSN_LOAD_GLOB,                    /* 142 */
-    INSN_REGEX_PADAV,                  /* 143 */
-    INSN_DOWARN,                       /* 144 */
-    INSN_COMPPAD_NAME,                 /* 145 */
-    INSN_XGV_STASH,                    /* 146 */
-    INSN_SIGNAL,                       /* 147 */
-    INSN_FORMFEED,                     /* 148 */
-    MAX_INSN = 148
-};
-
-enum {
-    OPt_OP,            /* 0 */
-    OPt_UNOP,          /* 1 */
-    OPt_BINOP,         /* 2 */
-    OPt_LOGOP,         /* 3 */
-    OPt_LISTOP,                /* 4 */
-    OPt_PMOP,          /* 5 */
-    OPt_SVOP,          /* 6 */
-    OPt_PADOP,         /* 7 */
-    OPt_PVOP,          /* 8 */
-    OPt_LOOP,          /* 9 */
-    OPt_COP            /* 10 */
-};
-
-/* ex: set ro: */
diff --git a/ext/ByteLoader/hints/sunos.pl b/ext/ByteLoader/hints/sunos.pl
deleted file mode 100644 (file)
index 3faf498..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-$self->{CCFLAGS} = $Config{ccflags} . ' -DNEED_FGETC_PROTOTYPE -DNEED_FREAD_PROTOTYPE';
-
diff --git a/ext/threads/shared/typemap b/ext/threads/shared/typemap
deleted file mode 100644 (file)
index e69de29..0000000
index ef19169..74d299f 100644 (file)
@@ -158,10 +158,4 @@ perlmodlib.pod:    $(PERL) perlmodlib.PL ../MANIFEST
        rm -f perlmodlib.pod
        $(PERL) -I ../lib perlmodlib.PL
 
-compile: all
-       $(REALPERL) -I../lib ../utils/perlcc -I .. -L .. -o pod2latex.exe pod2latex -log ../compilelog
-       $(REALPERL) -I../lib ../utils/perlcc -I .. -L .. -o pod2man.exe pod2man -log ../compilelog
-       $(REALPERL) -I../lib ../utils/perlcc -I .. -L .. -o pod2text.exe pod2text -log ../compilelog
-       $(REALPERL) -I../lib ../utils/perlcc -I .. -L .. -o checkpods.exe checkpods -log ../compilelog
-
 !NO!SUBS!
index 046576b..881f02b 100644 (file)
@@ -14,12 +14,11 @@ native executable.
 
 The C<B> module provides access to the parse tree, and other modules
 ("back ends") do things with the tree.  Some write it out as
-bytecode, C source code, or a semi-human-readable text.  Another
-traverses the parse tree to build a cross-reference of which
-subroutines, formats, and variables are used where.  Another checks
-your code for dubious constructs.  Yet another back end dumps the
-parse tree back out as Perl source, acting as a source code beautifier
-or deobfuscator.
+semi-human-readable text.  Another traverses the parse tree to build a
+cross-reference of which subroutines, formats, and variables are used
+where.  Another checks your code for dubious constructs.  Yet another back
+end dumps the parse tree back out as Perl source, acting as a source code
+beautifier or deobfuscator.
 
 Because its original purpose was to be a way to produce C code
 corresponding to a Perl program, and in turn a native executable, the
@@ -37,8 +36,7 @@ what problems there are, and how to work around them.
 
 The compiler back ends are in the C<B::> hierarchy, and the front-end
 (the module that you, the user of the compiler, will sometimes
-interact with) is the O module.  Some back ends (e.g., C<B::C>) have
-programs (e.g., I<perlcc>) to hide the modules' complexity.
+interact with) is the O module.
 
 Here are the important back ends to know about, with their status
 expressed as a number from 0 (outline for later implementation) to
@@ -46,30 +44,6 @@ expressed as a number from 0 (outline for later implementation) to
 
 =over 4
 
-=item B::Bytecode
-
-Stores the parse tree in a machine-independent format, suitable
-for later reloading through the ByteLoader module.  Status: 5 (some
-things work, some things don't, some things are untested).
-
-=item B::C
-
-Creates a C source file containing code to rebuild the parse tree
-and resume the interpreter.  Status: 6 (many things work adequately,
-including programs using Tk).
-
-=item B::CC
-
-Creates a C source file corresponding to the run time code path in
-the parse tree.  This is the closest to a Perl-to-C translator there
-is, but the code it generates is almost incomprehensible because it
-translates the parse tree into a giant switch structure that
-manipulates Perl structures.  Eventual goal is to reduce (given
-sufficient type information in the Perl program) some of the
-Perl data structure manipulations into manipulations of C-level
-ints, floats, etc.  Status: 5 (some things work, including
-uncomplicated Tk examples).
-
 =item B::Lint
 
 Complains if it finds dubious constructs in your source code.  Status:
@@ -216,58 +190,6 @@ To disable context checks and undefined subroutines:
 
 See L<B::Lint> for information on the options.
 
-=head2 The Simple C Back End
-
-This module saves the internal compiled state of your Perl program
-to a C source file, which can be turned into a native executable
-for that particular platform using a C compiler.  The resulting
-program links against the Perl interpreter library, so it
-will not save you disk space (unless you build Perl with a shared
-library) or program size.  It may, however, save you startup time.
-
-The C<perlcc> tool generates such executables by default.
-
-  perlcc myperlprogram.pl
-
-=head2 The Bytecode Back End
-
-This back end is only useful if you also have a way to load and
-execute the bytecode that it produces.  The ByteLoader module provides
-this functionality.
-
-To turn a Perl program into executable byte code, you can use C<perlcc>
-with the C<-B> switch:
-
-  perlcc -B myperlprogram.pl
-
-The byte code is machine independent, so once you have a compiled
-module or program, it is as portable as Perl source (assuming that
-the user of the module or program has a modern-enough Perl interpreter
-to decode the byte code).
-
-See B<B::Bytecode> for information on options to control the
-optimization and nature of the code generated by the Bytecode module.
-
-=head2 The Optimized C Back End
-
-The optimized C back end will turn your Perl program's run time
-code-path into an equivalent (but optimized) C program that manipulates
-the Perl data structures directly.  The program will still link against
-the Perl interpreter library, to allow for eval(), C<s///e>,
-C<require>, etc.
-
-The C<perlcc> tool generates such executables when using the -O
-switch.  To compile a Perl program (ending in C<.pl>
-or C<.p>):
-
-  perlcc -O myperlprogram.pl
-
-To produce a shared library from a Perl module (ending in C<.pm>):
-
-  perlcc -O Myperlmodule.pm
-
-For more information, see L<perlcc> and L<B::CC>.
-
 =head1 Module List for the Compiler Suite
 
 =over 4
@@ -289,54 +211,6 @@ called something like this:
 
 This is like saying C<use O 'Deparse'> in your Perl program.
 
-=item B::Asmdata
-
-This module is used by the B::Assembler module, which is in turn used
-by the B::Bytecode module, which stores a parse-tree as
-bytecode for later loading.  It's not a back end itself, but rather a
-component of a back end.
-
-=item B::Assembler
-
-This module turns a parse-tree into data suitable for storing
-and later decoding back into a parse-tree.  It's not a back end
-itself, but rather a component of a back end.  It's used by the
-I<assemble> program that produces bytecode.
-
-=item B::Bblock
-
-This module is used by the B::CC back end.  It walks "basic blocks".
-A basic block is a series of operations which is known to execute from
-start to finish, with no possibility of branching or halting.
-
-=item B::Bytecode
-
-This module is a back end that generates bytecode from a
-program's parse tree.  This bytecode is written to a file, from where
-it can later be reconstructed back into a parse tree.  The goal is to
-do the expensive program compilation once, save the interpreter's
-state into a file, and then restore the state from the file when the
-program is to be executed.  See L</"The Bytecode Back End">
-for details about usage.
-
-=item B::C
-
-This module writes out C code corresponding to the parse tree and
-other interpreter internal structures.  You compile the corresponding
-C file, and get an executable file that will restore the internal
-structures and the Perl interpreter will begin running the
-program.  See L</"The Simple C Back End"> for details about usage.
-
-=item B::CC
-
-This module writes out C code corresponding to your program's
-operations.  Unlike the B::C module, which merely stores the
-interpreter and its state in a C program, the B::CC module makes a
-C program that does not involve the interpreter.  As a consequence,
-programs translated into C by B::CC can execute faster than normal
-interpreted programs.  See L</"The Optimized C Back End"> for
-details about usage.
-
 =item B::Concise
 
 This module prints a concise (but complete) version of the Perl parse
@@ -359,12 +233,6 @@ It is useful in debugging and deconstructing other people's code,
 also as a pretty-printer for your own source.  See
 L</"The Decompiling Back End"> for details about usage.
 
-=item B::Disassembler
-
-This module turns bytecode back into a parse tree.  It's not a back
-end itself, but rather a component of a back end.  It's used by the
-I<disassemble> program that comes with the bytecode.
-
 =item B::Lint
 
 This module inspects the compiled form of your source code for things
@@ -387,19 +255,6 @@ To get a list of the my() variables used in the file myperlprogram:
 
 [BROKEN]
 
-=item B::Stackobj
-
-This module is used by the B::CC module.  It's not a back end itself,
-but rather a component of a back end.
-
-=item B::Stash
-
-This module is used by the L<perlcc> program, which compiles a module
-into an executable.  B::Stash prints the symbol tables in use by a
-program, and is used to prevent B::CC from producing C code for the
-B::* and O modules.  It's not a back end itself, but rather a
-component of a back end.
-
 =item B::Terse
 
 This module prints the contents of the parse tree, but without as much
@@ -421,19 +276,6 @@ usage.
 
 =head1 KNOWN PROBLEMS
 
-The simple C backend currently only saves typeglobs with alphanumeric
-names.
-
-The optimized C backend outputs code for more modules than it should
-(e.g., DirHandle).  It also has little hope of properly handling
-C<goto LABEL> outside the running subroutine (C<goto &sub> is okay).
-C<goto LABEL> currently does not work at all in this backend.
-It also creates a huge initialization function that gives
-C compilers headaches.  Splitting the initialization function gives
-better results.  Other problems include: unsigned math does not
-work correctly; some opcodes are handled incorrectly by default
-opcode handling mechanism.
-
 BEGIN{} blocks are executed while compiling your code.  Any external
 state that is initialized in BEGIN{}, such as opening files, initiating
 database connections etc., do not behave properly.  To work around
index 55bd4dc..c7b9e13 100644 (file)
--- a/regen.pl
+++ b/regen.pl
@@ -18,9 +18,7 @@ safer_unlink ("warnings.h", "lib/warnings.pm");
 
 my %gen = (
           'autodoc.pl'  => [qw[pod/perlapi.pod pod/perlintern.pod]],
-          'bytecode.pl' => [qw[ext/ByteLoader/byterun.h
-                               ext/ByteLoader/byterun.c
-                               ext/B/B/Asmdata.pm]],
+          'bytecode.pl' => [qw[ext/B/B/Asmdata.pm]],
           'embed.pl'    => [qw[proto.h embed.h embedvar.h global.sym
                                perlapi.h perlapi.c]],
           'keywords.pl' => [qw[keywords.h]],
diff --git a/t/TEST b/t/TEST
index 8e02299..22d814d 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -29,8 +29,6 @@ our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
        $::torture = 1 if $1 eq 'torture';
        $::with_utf8 = 1 if $1 eq 'utf8';
        $::with_utf16 = 1 if $1 eq 'utf16';
-       $::bytecompile = 1 if $1 eq 'bytecompile';
-       $::compile = 1 if $1 eq 'compile';
        $::taintwarn = 1 if $1 eq 'taintwarn';
        $ENV{PERL_CORE_MINITEST} = 1 if $1 eq 'minitest';
        if ($1 =~ /^deparse(,.+)?$/) {
@@ -171,19 +169,9 @@ unless (@ARGV) {
     }
 }
 
-# Tests known to cause infinite loops for the perlcc tests.
-# %::infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
-%::infinite = ();
-
 if ($::deparse) {
     _testprogs('deparse', '',   @ARGV);
 }
-elsif( $::compile ) {
-    _testprogs('compile', '',   @ARGV);
-}
-elsif( $::bytecompile ) {
-    _testprogs('bytecompile', '', @ARGV);
-}
 elsif ($::with_utf16) {
     for my $e (0, 1) {
        for my $b (0, 1) {
@@ -211,34 +199,18 @@ elsif ($::with_utf16) {
     }
 }
 else {
-    _testprogs('compile', '',   @ARGV) if -e "../testcompile";
     _testprogs('perl',    '',   @ARGV);
 }
 
 sub _testprogs {
     my ($type, $args, @tests) = @_;
 
-    print <<'EOT' if ($type eq 'compile');
-------------------------------------------------------------------------------
-TESTING COMPILER
-------------------------------------------------------------------------------
-EOT
-
     print <<'EOT' if ($type eq 'deparse');
 ------------------------------------------------------------------------------
 TESTING DEPARSER
 ------------------------------------------------------------------------------
 EOT
 
-    print <<EOT if ($type eq 'bytecompile');
-------------------------------------------------------------------------------
-TESTING BYTECODE COMPILER
-------------------------------------------------------------------------------
-EOT
-
-    $ENV{PERLCC_TIMEOUT} = 120
-         if ($type eq 'compile' && !$ENV{PERLCC_TIMEOUT});
-
     $::bad_files = 0;
 
     foreach my $t (@tests) {
@@ -267,10 +239,6 @@ EOT
     while (my $test = shift @tests) {
         my $test_start_time = $show_elapsed_time ? Time::HiRes::time() : 0;
 
-       if ( $::infinite{$test} && $type eq 'compile' ) {
-           print STDERR "$test creates infinite loop! Skipping.\n";
-           next;
-       }
        if ($test =~ /^$/) {
            next;
        }
@@ -315,7 +283,6 @@ EOT
            }
        }
 
-       my $test_executable; # for 'compile' tests
        my $file_opts = "";
        if ($type eq 'deparse') {
            # Look for #line directives which change the filename
@@ -337,31 +304,6 @@ EOT
            open(RESULTS, $deparse_cmd)
                or print "can't deparse '$deparse_cmd': $!.\n";
        }
-       elsif ($type eq 'bytecompile') {
-           my ($pwd, $null);
-           if( $^O eq 'MSWin32') {
-               $pwd = `cd`;
-               $null = 'nul';
-           } else {
-               $pwd = `pwd`;
-               $null = '/dev/null';
-           }
-           chomp $pwd;
-           my $perl = $ENV{PERL} || "$pwd/perl";
-           my $bswitch = "-MO=Bytecode,-H,-TI,-s$pwd/$test,";
-           $bswitch .= "-TF$test.plc,"
-               if $test =~ m(chdir|pod/|CGI/t/carp|lib/DB);
-           $bswitch .= "-k,"
-               if $test =~ m(deparse|terse|ext/Storable/t/code);
-           $bswitch .= "-b,"
-               if $test =~ m(op/getpid);
-           my $bytecompile_cmd =
-               "$perl $testswitch $switch -I../lib $bswitch".
-               "-o$test.plc $test 2>$null &&".
-               "$perl $testswitch $switch -I../lib $utf8 $test.plc |";
-           open(RESULTS,$bytecompile_cmd)
-               or print "can't byte-compile '$bytecompile_cmd': $!.\n";
-       }
        elsif ($type eq 'perl') {
            my $perl = $ENV{PERL} || './perl';
            my $redir = $^O eq 'VMS' ? '2>&1' : '';
@@ -376,38 +318,6 @@ EOT
                              . " $test $redir|";
            open(RESULTS,$run) or print "can't run '$run': $!.\n";
        }
-       else {
-           my $compile_cmd;
-           my $pl2c = "$testswitch -I../lib ../utils/perlcc --testsuite " .
-             # -O9 for good measure, -fcog is broken ATM
-                      "$switch -Wb=-O9,-fno-cog -L .. " .
-                      "-I \".. ../lib/CORE\" $args $utf8 $test -o ";
-
-           if( $^O eq 'MSWin32' ) {
-               $test_executable = "$test.exe";
-               # hopefully unused name...
-               open HACK, "> xweghyz.pl";
-               print HACK <<EOT;
-#!./perl
-
-open HACK, '.\\perl $pl2c $test_executable |';
-# cl.exe prints the name of the .c file on stdout (\%^\$^#)
-while(<HACK>) {m/^\\w+\\.[cC]\$/ && next;print}
-open HACK, '$test_executable |';
-while(<HACK>) {print}
-EOT
-               close HACK;
-               $compile_cmd = 'xweghyz.pl |';
-           }
-           else {
-               $test_executable = "$test.plc";
-               $compile_cmd
-                   = "./perl $pl2c $test_executable && $test_executable |";
-           }
-           unlink $test_executable if -f $test_executable;
-           open(RESULTS, $compile_cmd)
-               or print "can't compile '$compile_cmd': $!.\n";
-       }
        # Our environment may force us to use UTF-8, but we can't be sure that
        # anything we're reading from will be generating (well formed) UTF-8
        # This may not be the best way - possibly we should unset ${^OPEN} up
@@ -555,10 +465,6 @@ EOT
            rename("perl.3log", $tpp) ||
                die "rename: perl3.log to $tpp: $!\n";
        }
-       # test if the compiler compiled something
-       if( $type eq 'compile' && !-e "$test_executable" ) {
-           $failure = "Test did not compile";
-       }
        if (not defined $failure and $next != $max) {
            $failure="FAILED--expected $max tests, saw $next";
        }
index b58bbb5..8c8ffaa 100644 (file)
--- a/t/harness
+++ b/t/harness
@@ -126,42 +126,4 @@ if ($^O eq 'MSWin32') {
 @tests=grep /$re/, @tests 
     if $re;
 Test::Harness::runtests @tests;
-exit(0) unless -e "../testcompile";
-
-# %infinite =  qw (
-#        op/bop.t      1
-#        lib/hostname.t        1
-#       op/lex_assign.t        1
-#       lib/ph.t       1
-#        );
-
-my $dhwrapper = <<'EOT';
-open DATA,"<".__FILE__;
-until (($_=<DATA>) =~ /^__END__/) {};
-EOT
-
-@tests = grep (!$infinite{$_}, @tests);
-@tests = map {
-         my $new = $_;
-        if ($datahandle{$_} && !( -f "$new.t") ) {
-             $new .= '.t';
-             local(*F, *T);
-             open(F,"<$_") or die "Can't open $_: $!";
-             open(T,">$new") or die "Can't open $new: $!";
-             print T $dhwrapper, <F>;
-             close F;
-             close T;
-         }
-         $new;
-         } @tests;
-
-print "The tests ", join(' ', keys(%infinite)),
-    " generate infinite loops! Skipping!\n";
-
-$ENV{'HARNESS_COMPILE_TEST'} = 1;
-$ENV{'PERLCC_TIMEOUT'} = 120 unless $ENV{'PERLCC_TIMEOUT'};
-
-Test::Harness::runtests @tests;
-foreach (keys %datahandle) {
-     unlink "$_.t";
-}
+exit(0);
index 9e86158..72628c3 100644 (file)
@@ -24,9 +24,6 @@ if (eval { require Socket }) {
       push @Core_Modules, qw(Net::Cmd Net::POP3);
   }
 }
-if(eval { require B }) {
-  push @Core_Modules, qw(B::C B::CC B::Stackobj);
-}
 
 @Core_Modules = sort @Core_Modules;
 
index 6f7579d..7de9fbb 100644 (file)
--- a/utils.lst
+++ b/utils.lst
@@ -16,7 +16,6 @@ utils/h2xs
 utils/instmodsh
 utils/libnetcfg
 utils/perlbug
-utils/perlcc
 utils/perldoc   # pod = pod/perldoc.pod
 utils/perlivp
 utils/piconv
index 1835633..a37a570 100644 (file)
@@ -5,25 +5,12 @@ REALPERL = ../perl
 # Files to be built with variable substitution after miniperl is
 # available.  Dependencies handled manually below (for now).
 
-pl = c2ph.PL config_data.PL corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL ptar.PL ptardiff.PL shasum.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL
-plextract = c2ph config_data corelist cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove ptar ptardiff shasum splain perlcc dprofpp libnetcfg piconv enc2xs xsubpp
-plextractexe = ./c2ph ./config_data ./corelist ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./ptar ./ptardiff ./shasum ./splain ./perlcc ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp
+pl = c2ph.PL config_data.PL corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL ptar.PL ptardiff.PL shasum.PL splain.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL
+plextract = c2ph config_data corelist cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove ptar ptardiff shasum splain dprofpp libnetcfg piconv enc2xs xsubpp
+plextractexe = ./c2ph ./config_data ./corelist ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./ptar ./ptardiff ./shasum ./splain ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp
 
 all: $(plextract) 
 
-compile: all $(plextract)
-       $(REALPERL) -I../lib perlcc -I .. -L .. c2ph -o c2ph.exe -v 10 -log ../compilelog;
-       $(REALPERL) -I../lib perlcc -I .. -L .. h2ph -o h2ph.exe -v 10 -log ../compilelog;
-       $(REALPERL) -I../lib perlcc -I .. -L .. h2xs -o h2xs.exe -v 10 -log ../compilelog;
-       $(REALPERL) -I../lib perlcc -I .. -L .. perlbug -o perlbug.exe -v 10 -log ../compilelog;
-       $(REALPERL) -I../lib perlcc -I .. -L .. perldoc -o perldoc.exe -v 10 -log ../compilelog;
-       $(REALPERL) -I../lib perlcc -I .. -L .. perlivp -o perlivp.exe -v 10 -log ../compilelog;
-       $(REALPERL) -I../lib perlcc -I .. -L .. pl2pm -o pl2pm.exe -v 10 -log ../compilelog;
-       $(REALPERL) -I../lib perlcc -I .. -L .. splain -o splain.exe -v 10 -log ../compilelog;
-       $(REALPERL) -I../lib perlcc -I .. -L .. perlcc -I .. -L .. -o perlcc.exe -v 10 -log ../compilelog;
-       $(REALPERL) -I../lib perlcc -I .. -L .. dprofpp -o dprofpp.exe -v 10 -log ../compilelog;
-       $(REALPERL) -I../lib perlcc -I .. -L .. libnetcfg -o libnetcfg.exe -v 10 -log ../compilelog;
-
 $(plextract):
        $(PERL) -I../lib $@.PL
 
@@ -59,8 +46,6 @@ shasum:               shasum.PL ../config.sh
 
 splain:                splain.PL ../config.sh ../lib/diagnostics.pm
 
-perlcc:                perlcc.PL ../config.sh
-
 dprofpp:       dprofpp.PL ../config.sh
 
 libnetcfg:     libnetcfg.PL ../config.sh
diff --git a/utils/perlcc.PL b/utils/perlcc.PL
deleted file mode 100644 (file)
index 361069e..0000000
+++ /dev/null
@@ -1,691 +0,0 @@
-#!/usr/local/bin/perl
-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
-# have to mention them as if they were shell variables, not
-# %Config entries.  Thus you write
-#  $startperl
-# to ensure Configure will look for $Config{startperl}.
-# Wanted:  $archlibexp
-# 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';
-open OUT,">$file" or die "Can't create $file: $!";
-print "Extracting $file (with variable substitutions)\n";
-# In this section, perl variables will be expanded during extraction.
-# You can use $Config{...} to use Configure variables.
-print OUT <<"!GROK!THIS!";
-$Config{startperl}
-    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
-    if \$running_under_some_shell;
---\$running_under_some_shell;
-!GROK!THIS!
-# In the following, perl variables are not expanded during extraction.
-print OUT <<'!NO!SUBS!';
-
-# Version 2.0, Simon Cozens, Thu Mar 30 17:52:45 JST 2000 
-# Version 2.01, Tom Christiansen, Thu Mar 30 08:25:14 MST 2000
-# Version 2.02, Simon Cozens, Sun Apr 16 01:53:36 JST 2000
-# Version 2.03, Edward Peschko, Mon Feb 26 12:04:17 PST 2001
-# Version 2.04, Enache Adrian,Fri, 18 Jul 2003 23:15:37 +0300
-
-use strict;
-use warnings;
-use 5.006_000;
-
-use FileHandle;
-use Config;
-use Fcntl qw(:DEFAULT :flock);
-use File::Temp qw(tempfile);
-use Cwd;
-our $VERSION = 2.04;
-$| = 1;
-
-$SIG{INT} = sub { exit(); }; # exit gracefully and clean up after ourselves.
-
-use subs qw{
-    cc_harness check_read check_write checkopts_byte choose_backend
-    compile_byte compile_cstyle compile_module generate_code
-    grab_stash parse_argv sanity_check vprint yclept spawnit
-};
-sub opt(*); # imal quoting
-sub is_win32();
-sub is_msvc();
-
-our ($Options, $BinPerl, $Backend);
-our ($Input => $Output);
-our ($logfh);
-our ($cfile);
-our (@begin_output); # output from BEGIN {}, for testsuite
-
-# eval { main(); 1 } or die;
-
-main();
-
-sub main {
-    parse_argv();
-    check_write($Output);
-    choose_backend();
-    generate_code();
-    run_code();
-    _die("XXX: Not reached?");
-}
-
-#######################################################################
-
-sub choose_backend {
-    # Choose the backend.
-    $Backend = 'C';
-    if (opt(B)) {
-        checkopts_byte();
-        $Backend = 'Bytecode';
-    }
-    if (opt(S) && opt(c)) {
-        # die "$0: Do you want me to compile this or not?\n";
-        delete $Options->{S};
-    }
-    $Backend = 'CC' if opt(O);
-}
-
-
-sub generate_code { 
-
-    vprint 0, "Compiling $Input";
-
-    $BinPerl  = yclept();  # Calling convention for perl.
-
-    if (opt(shared)) {
-        compile_module();
-    } else {
-        if ($Backend eq 'Bytecode') {
-            compile_byte();
-        } else {
-            compile_cstyle();
-        }
-    }
-    exit(0) if (!opt('r'));
-}
-
-sub run_code {
-    vprint 0, "Running code";
-    run("$Output @ARGV");
-    exit(0);
-}
-
-# usage: vprint [level] msg args
-sub vprint {
-    my $level;
-    if (@_ == 1) {
-        $level = 1;
-    } elsif ($_[0] =~ /^\d$/) {
-        $level = shift;
-    } else {
-        # well, they forgot to use a number; means >0
-        $level = 0;
-    } 
-    my $msg = "@_";
-    $msg .= "\n" unless substr($msg, -1) eq "\n";
-    if (opt(v) > $level)
-    {
-         print        "$0: $msg" if !opt('log');
-        print $logfh "$0: $msg" if  opt('log');
-    }
-}
-
-sub parse_argv {
-
-    use Getopt::Long; 
-
-    # disallows using long arguments
-    # Getopt::Long::Configure("bundling");
-
-    Getopt::Long::Configure("no_ignore_case");
-
-    # no difference in exists and defined for %ENV; also, a "0"
-    # argument or a "" would not help cc, so skip
-    unshift @ARGV, split ' ', $ENV{PERLCC_OPTS} if $ENV{PERLCC_OPTS};
-
-    $Options = {};
-    Getopt::Long::GetOptions( $Options,
-        'L:s',          # lib directory
-        'I:s',          # include directories (FOR C, NOT FOR PERL)
-        'o:s',          # Output executable
-        'v:i',          # Verbosity level
-        'e:s',          # One-liner
-       'r',            # run resulting executable
-        'B',            # Byte compiler backend
-        'O',            # Optimised C backend
-        'c',            # Compile only
-        'h',            # Help me
-        'S',            # Dump C files
-       'r',            # run the resulting executable
-        'T',            # run the backend using perl -T
-        't',            # run the backend using perl -t
-        'static',       # Dirty hack to enable -shared/-static
-        'shared',       # Create a shared library (--shared for compat.)
-       'log:s',        # where to log compilation process information
-        'Wb:s',         # pass (comma-sepearated) options to backend
-        'testsuite',    # try to be nice to testsuite
-    );
-
-    $Options->{v} += 0;
-
-    if( opt(t) && opt(T) ) {
-        warn "Can't specify both -T and -t, -t ignored";
-        $Options->{t} = 0;
-    }
-
-    helpme() if opt(h); # And exit
-
-    $Output = opt(o) || ( is_win32 ? 'a.exe' : 'a.out' );
-    $Output = is_win32() ? $Output : relativize($Output);
-    $logfh  = new FileHandle(">> " . opt('log')) if (opt('log'));
-
-    if (opt(e)) {
-        warn "$0: using -e 'code' as input file, ignoring @ARGV\n" if @ARGV;
-        # We don't use a temporary file here; why bother?
-        # XXX: this is not bullet proof -- spaces or quotes in name!
-        $Input = is_win32() ? # Quotes eaten by shell
-            '-e "'.opt(e).'"' :
-            "-e '".opt(e)."'";
-    } else {
-        $Input = shift @ARGV;  # XXX: more files?
-        _usage_and_die("$0: No input file specified\n") unless $Input;
-        # DWIM modules. This is bad but necessary.
-        $Options->{shared}++ if $Input =~ /\.pm\z/;
-        warn "$0: using $Input as input file, ignoring @ARGV\n" if @ARGV;
-        check_read($Input);
-        check_perl($Input);
-        sanity_check();
-    }
-
-}
-
-sub opt(*) {
-    my $opt = shift;
-    return exists($Options->{$opt}) && ($Options->{$opt} || 0);
-} 
-
-sub compile_module { 
-    die "$0: Compiling to shared libraries is currently disabled\n";
-}
-
-sub compile_byte {
-    my $command = "$BinPerl -MO=Bytecode,-H,-o$Output $Input";
-    $Input =~ s/^-e.*$/-e/;
-
-    my ($output_r, $error_r) = spawnit($command);
-
-    if (@$error_r && $? != 0) {
-       _die("$0: $Input did not compile:\n@$error_r\n");
-    } else {
-       my @error = grep { !/^$Input syntax OK$/o } @$error_r;
-       warn "$0: Unexpected compiler output:\n@error" if @error;
-    }
-
-    chmod 0777 & ~umask, $Output    or _die("can't chmod $Output: $!");
-    exit 0;
-}
-
-sub compile_cstyle {
-    my $stash = grab_stash();
-    my $taint = opt(T) ? '-T' :
-                opt(t) ? '-t' : '';
-
-    # What are we going to call our output C file?
-    my $lose = 0;
-    my ($cfh);
-    my $testsuite = '';
-    my $addoptions = opt(Wb);
-
-    if( $addoptions ) {
-        $addoptions .= ',' if $addoptions !~ m/,$/;
-    }
-
-    if (opt(testsuite)) {
-        my $bo = join '', @begin_output;
-        $bo =~ s/\\/\\\\\\\\/gs;
-        $bo =~ s/\n/\\n/gs;
-        $bo =~ s/,/\\054/gs;
-        # don't look at that: it hurts
-        $testsuite = q{-fuse-script-name,-fsave-data,-fsave-sig-hash,}.
-            qq[-e"print q{$bo}",] .
-            q{-e"open(Test::Builder::TESTOUT\054 '>&STDOUT') or die $!",} .
-            q{-e"open(Test::Builder::TESTERR\054 '>&STDERR') or die $!",};
-    }
-    if (opt(S) || opt(c)) {
-        # We need to keep it.
-        if (opt(e)) {
-            $cfile = "a.out.c";
-        } else {
-            $cfile = $Input;
-            # File off extension if present
-            # hold on: plx is executable; also, careful of ordering!
-            $cfile =~ s/\.(?:p(?:lx|l|h)|m)\z//i;
-            $cfile .= ".c";
-            $cfile = $Output if opt(c) && $Output =~ /\.c\z/i;
-        }
-        check_write($cfile);
-    } else {
-        # Don't need to keep it, be safe with a tempfile.
-        $lose = 1;
-        ($cfh, $cfile) = tempfile("pccXXXXX", SUFFIX => ".c"); 
-        close $cfh; # See comment just below
-    }
-    vprint 1, "Writing C on $cfile";
-
-    my $max_line_len = '';
-    if ($^O eq 'MSWin32' && $Config{cc} =~ /^cl/i) {
-        $max_line_len = '-l2000,';
-    }
-
-    # This has to do the write itself, so we can't keep a lock. Life
-    # sucks.
-    my $command = "$BinPerl $taint -MO=$Backend,$addoptions$testsuite$max_line_len$stash,-o$cfile $Input";
-    vprint 1, "Compiling...";
-    vprint 1, "Calling $command";
-
-       my ($output_r, $error_r) = spawnit($command);
-       my @output = @$output_r;
-       my @error = @$error_r;
-
-    if (@error && $? != 0) {
-        _die("$0: $Input did not compile, which can't happen:\n@error\n");
-    }
-
-    is_msvc ?
-        cc_harness_msvc($cfile,$stash) :
-        cc_harness($cfile,$stash) unless opt(c);
-
-    if ($lose) {
-        vprint 2, "unlinking $cfile";
-        unlink $cfile or _die("can't unlink $cfile: $!"); 
-    }
-}
-
-sub cc_harness_msvc {
-    my ($cfile,$stash)=@_;
-    use ExtUtils::Embed ();
-    my $obj = "${Output}.obj";
-    my $compile = ExtUtils::Embed::ccopts." -c -Fo$obj $cfile ";
-    my $link = "-out:$Output $obj";
-    $compile .= " -I".$_ for split /\s+/, opt(I);
-    $link .= " -libpath:".$_ for split /\s+/, opt(L);
-    my @mods = split /-?u /, $stash;
-    $link .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
-    $link .= " perl5$Config{PERL_VERSION}.lib kernel32.lib msvcrt.lib";
-    vprint 3, "running $Config{cc} $compile";
-    system("$Config{cc} $compile");
-    vprint 3, "running $Config{ld} $link";
-    system("$Config{ld} $link");
-}
-
-sub cc_harness {
-       my ($cfile,$stash)=@_;
-       use ExtUtils::Embed ();
-       my $command = ExtUtils::Embed::ccopts." -o $Output $cfile ";
-       $command .= " -I".$_ for split /\s+/, opt(I);
-       $command .= " -L".$_ for split /\s+/, opt(L);
-       my @mods = split /-?u /, $stash;
-       $command .= " ".ExtUtils::Embed::ldopts("-std", \@mods);
-        $command .= " -lperl";
-       vprint 3, "running $Config{cc} $command";
-       system("$Config{cc} $command");
-}
-
-# Where Perl is, and which include path to give it.
-sub yclept {
-    my $command = "$^X ";
-
-    # DWIM the -I to be Perl, not C, include directories.
-    if (opt(I) && $Backend eq "Bytecode") {
-        for (split /\s+/, opt(I)) {
-            if (-d $_) {
-                push @INC, $_;
-            } else {
-                warn "$0: Include directory $_ not found, skipping\n";
-            }
-        }
-    }
-            
-    $command .= "-I$_ " for @INC;
-    return $command;
-}
-
-# Use B::Stash to find additional modules and stuff.
-{
-    my $_stash;
-    sub grab_stash {
-
-        warn "already called get_stash once" if $_stash;
-
-        my $taint = opt(T) ? '-T' :
-                    opt(t) ? '-t' : '';
-        my $command = "$BinPerl $taint -MB::Stash -c $Input";
-        # Filename here is perfectly sanitised.
-        vprint 3, "Calling $command\n";
-
-               my ($stash_r, $error_r) = spawnit($command);
-               my @stash = @$stash_r;
-               my @error = @$error_r;
-
-       if (@error && $? != 0) {
-            _die("$0: $Input did not compile:\n@error\n");
-        }
-
-        # band-aid for modules with noisy BEGIN {}
-        foreach my $i ( @stash ) {
-            $i =~ m/-u(?:[\w:]+|\<none\>)$/ and $stash[0] = $i and next;
-            push @begin_output, $i;
-        }
-        chomp $stash[0];
-        $stash[0] =~ s/,-u\<none\>//;
-        $stash[0] =~ s/^.*?-u/-u/s;
-        vprint 2, "Stash: ", join " ", split /,?-u/, $stash[0];
-        chomp $stash[0];
-        return $_stash = $stash[0];
-    }
-
-}
-
-# Check the consistency of options if -B is selected.
-# To wit, (-B|-O) ==> no -shared, no -S, no -c
-sub checkopts_byte {
-
-    _die("$0: Please choose one of either -B and -O.\n") if opt(O);
-
-    if (opt(shared)) {
-        warn "$0: Will not create a shared library for bytecode\n";
-        delete $Options->{shared};
-    }
-
-    for my $o ( qw[c S] ) { 
-        if (opt($o)) { 
-            warn "$0: Compiling to bytecode is a one-pass process--",
-                  "-$o ignored\n";
-            delete $Options->{$o};
-        }
-    }
-
-}
-
-# Check the input and output files make sense, are read/writeable.
-sub sanity_check {
-    if ($Input eq $Output) {
-        if ($Input eq 'a.out') {
-            _die("$0: Compiling a.out is probably not what you want to do.\n");
-            # You fully deserve what you get now. No you *don't*. typos happen.
-        } else {
-            warn "$0: Will not write output on top of input file, ",
-                "compiling to a.out instead\n";
-            $Output = "a.out";
-        }
-    }
-}
-
-sub check_read { 
-    my $file = shift;
-    unless (-r $file) {
-        _die("$0: Input file $file is a directory, not a file\n") if -d _;
-        unless (-e _) {
-            _die("$0: Input file $file was not found\n");
-        } else {
-            _die("$0: Cannot read input file $file: $!\n");
-        }
-    }
-    unless (-f _) {
-        # XXX: die?  don't try this on /dev/tty
-        warn "$0: WARNING: input $file is not a plain file\n";
-    } 
-}
-
-sub check_write {
-    my $file = shift;
-    if (-d $file) {
-        _die("$0: Cannot write on $file, is a directory\n");
-    }
-    if (-e _) {
-        _die("$0: Cannot write on $file: $!\n") unless -w _;
-    } 
-    unless (-w cwd()) { 
-        _die("$0: Cannot write in this directory: $!\n");
-    }
-}
-
-sub check_perl {
-    my $file = shift;
-    unless (-T $file) {
-        warn "$0: Binary `$file' sure doesn't smell like perl source!\n";
-        print "Checking file type... ";
-        system("file", $file);  
-        _die("Please try a perlier file!\n");
-    } 
-
-    open(my $handle, "<", $file)    or _die("XXX: can't open $file: $!");
-    local $_ = <$handle>;
-    if (/^#!/ && !/perl/) {
-        _die("$0: $file is a ", /^#!\s*(\S+)/, " script, not perl\n");
-    } 
-
-} 
-
-# File spawning and error collecting
-sub spawnit {
-       my ($command) = shift;
-       my (@error,@output);
-       my $errname;
-       (undef, $errname) = tempfile("pccXXXXX");
-       { 
-       open (S_OUT, "$command 2>$errname |")
-               or _die("$0: Couldn't spawn the compiler.\n");
-       @output = <S_OUT>;
-       }
-       open (S_ERROR, $errname) or _die("$0: Couldn't read the error file.\n");
-       @error = <S_ERROR>;
-       close S_ERROR;
-       close S_OUT;
-       unlink $errname or _die("$0: Can't unlink error file $errname");
-       return (\@output, \@error);
-}
-
-sub helpme {
-       print "perlcc compiler frontend, version $VERSION\n\n";
-       { no warnings;
-       exec "pod2usage $0";
-       exec "perldoc $0";
-       exec "pod2text $0";
-       }
-}
-
-sub relativize {
-       my ($args) = @_;
-
-       return() if ($args =~ m"^[/\\]");
-       return("./$args");
-}
-
-sub _die {
-    $logfh->print(@_) if opt('log');
-    print STDERR @_;
-    exit(); # should die eventually. However, needed so that a 'make compile'
-            # can compile all the way through to the end for standard dist.
-}
-
-sub _usage_and_die {
-    _die(<<EOU);
-$0: Usage:
-$0 [-o executable] [-r] [-O|-B|-c|-S] [-I /foo] [-L /foo] [-log log] [source[.pl] | -e oneliner]
-EOU
-}
-
-sub run {
-    my (@commands) = @_;
-
-    print interruptrun(@commands) if (!opt('log'));
-    $logfh->print(interruptrun(@commands)) if (opt('log'));
-}
-
-sub interruptrun
-{
-    my (@commands) = @_;
-
-    my $command = join('', @commands);
-    local(*FD);
-    my $pid = open(FD, "$command |");
-    my $text;
-    
-    local($SIG{HUP}) = sub { kill 9, $pid; exit };
-    local($SIG{INT}) = sub { kill 9, $pid; exit };
-
-    my $needalarm = 
-          ($ENV{PERLCC_TIMEOUT} && 
-         $Config{'osname'} ne 'MSWin32' && 
-         $command =~ m"(^|\s)perlcc\s");
-
-    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 };
-        vprint 0, "SYSTEM TIMEOUT (infinite loop?)\n";
-    }
-
-    close(FD);
-    return($text);
-}
-
-sub is_win32() { $^O =~ m/^MSWin/ }
-sub is_msvc() { is_win32 && $Config{cc} =~ m/^cl/i }
-
-END {
-    unlink $cfile if ($cfile && !opt(S) && !opt(c));
-}
-
-__END__
-
-=head1 NAME
-
-perlcc - generate executables from Perl programs
-
-=head1 SYNOPSIS
-
-    $ perlcc hello              # Compiles into executable 'a.out'
-    $ perlcc -o hello hello.pl  # Compiles into executable 'hello'
-
-    $ perlcc -O file            # Compiles using the optimised C backend
-    $ perlcc -B file            # Compiles using the bytecode backend
-
-    $ perlcc -c file            # Creates a C file, 'file.c'
-    $ perlcc -S -o hello file   # Creates a C file, 'file.c',
-                                # then compiles it to executable 'hello'
-    $ perlcc -c out.c file      # Creates a C file, 'out.c' from 'file'
-
-    $ perlcc -e 'print q//'     # Compiles a one-liner into 'a.out'
-    $ perlcc -c -e 'print q//'  # Creates a C file 'a.out.c'
-
-    $ perlcc -I /foo hello     # extra headers (notice the space after -I)
-    $ perlcc -L /foo hello     # extra libraries (notice the space after -L)
-
-    $ perlcc -r hello           # compiles 'hello' into 'a.out', runs 'a.out'.
-    $ perlcc -r hello a b c     # compiles 'hello' into 'a.out', runs 'a.out'.
-                                # with arguments 'a b c' 
-
-    $ perlcc hello -log c       # compiles 'hello' into 'a.out' logs compile
-                                # log into 'c'. 
-
-=head1 DESCRIPTION
-
-F<perlcc> creates standalone executables from Perl programs, using the
-code generators provided by the L<B> module. At present, you may
-either create executable Perl bytecode, using the C<-B> option, or 
-generate and compile C files using the standard and 'optimised' C
-backends.
-
-The code generated in this way is not guaranteed to work. The whole
-codegen suite (C<perlcc> included) should be considered B<very>
-experimental. Use for production purposes is strongly discouraged.
-
-=head1 OPTIONS
-
-=over 4
-
-=item -LI<library directories>
-
-Adds the given directories to the library search path when C code is
-passed to your C compiler.
-
-=item -II<include directories>
-
-Adds the given directories to the include file search path when C code is
-passed to your C compiler; when using the Perl bytecode option, adds the
-given directories to Perl's include path.
-
-=item -o I<output file name>
-
-Specifies the file name for the final compiled executable.
-
-=item -c I<C file name>
-
-Create C code only; do not compile to a standalone binary.
-
-=item -e I<perl code>
-
-Compile a one-liner, much the same as C<perl -e '...'>
-
-=item -S
-
-Do not delete generated C code after compilation.
-
-=item -B
-
-Use the Perl bytecode code generator.
-
-=item -O
-
-Use the 'optimised' C code generator. This is more experimental than
-everything else put together, and the code created is not guaranteed to
-compile in finite time and memory, or indeed, at all.
-
-=item -v
-
-Increase verbosity of output; can be repeated for more verbose output.
-
-=item -r 
-
-Run the resulting compiled script after compiling it.
-
-=item -log
-
-Log the output of compiling to a file rather than to stdout.
-
-=back
-
-=cut
-
-!NO!SUBS!
-
-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;
index c7b85e9..d789ea4 100644 (file)
@@ -353,7 +353,7 @@ unidatadirs = lib/unicore/To lib/unicore/lib
 LIBPREREQ = $(ARCHDIR)Config.pm $(ARCHDIR)Config_heavy.pl [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm [.lib]XSLoader.pm [.lib]lib.pm [.lib.ExtUtils]XSSymSet.pm $(ARCHDIR)vmspipe.com [.lib]re.pm unidatafiles.ts
 
 utils1 = [.lib.pods]perldoc.com [.lib.ExtUtils]Miniperl.pm [.utils]c2ph.com [.utils]h2ph.com 
-utils2 = [.utils]h2xs.com [.utils]libnetcfg.com [.lib]perlbug.com [.lib]perlcc.com [.utils]dprofpp.com 
+utils2 = [.utils]h2xs.com [.utils]libnetcfg.com [.lib]perlbug.com [.utils]dprofpp.com 
 utils3 = [.utils]perlivp.com [.lib]splain.com [.utils]pl2pm.com [.utils]xsubpp.com [.utils]instmodsh.com
 utils4 = [.utils]enc2xs.com [.utils]piconv.com [.utils]cpan.com [.utils]prove.com [.utils]ptar.com [.utils]ptardiff.com [.utils]shasum.com
 utils5 = [.utils]corelist.com [.utils]config_data.com
@@ -603,10 +603,6 @@ dynext : $(LIBPREREQ) $(DBG)perlshr$(E) preplibrary makeppport
        $(MINIPERL) -"I[-.lib]" $(MMS$SOURCE)
        Copy/NoConfirm/Log [.utils]perlbug.com [.lib]
 
-[.lib]perlcc.com : [.utils]perlcc.PL $(ARCHDIR)Config.pm
-       $(MINIPERL) -"I[-.lib]" $(MMS$SOURCE)
-       Copy/NoConfirm/Log [.utils]perlcc.com [.lib]
-
 [.utils]piconv.com : [.utils]piconv.PL $(ARCHDIR)Config.pm
        $(MINIPERL) -"I[-.lib]" $(MMS$SOURCE)
 
index a449a4b..2ab3254 100644 (file)
@@ -545,7 +545,6 @@ UTILS               =                       \
                ..\utils\pstruct        \
                ..\utils\h2xs           \
                ..\utils\perldoc        \
-               ..\utils\perlcc         \
                ..\utils\perlivp        \
                ..\utils\libnetcfg      \
                ..\utils\enc2xs         \
@@ -1237,7 +1236,7 @@ distclean: realclean
            pod2html pod2latex pod2man pod2text pod2usage \
            podchecker podselect
        -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \
-           perldoc perlivp dprofpp perlcc libnetcfg enc2xs piconv cpan *.bat \
+           perldoc perlivp dprofpp libnetcfg enc2xs piconv cpan *.bat \
            xsubpp instmodsh prove ptar ptardiff shasum corelist config_data
        -cd ..\x2p && del /f find2perl s2p psed *.bat
        -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
index 8477401..bf05fc2 100644 (file)
@@ -689,7 +689,6 @@ UTILS               =                       \
                ..\utils\pstruct        \
                ..\utils\h2xs           \
                ..\utils\perldoc        \
-               ..\utils\perlcc         \
                ..\utils\perlivp        \
                ..\utils\libnetcfg      \
                ..\utils\enc2xs         \
@@ -1372,7 +1371,7 @@ distclean: realclean
            pod2html pod2latex pod2man pod2text pod2usage \
            podchecker podselect
        -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \
-           perldoc perlivp dprofpp perlcc libnetcfg enc2xs piconv cpan *.bat \
+           perldoc perlivp dprofpp libnetcfg enc2xs piconv cpan *.bat \
            xsubpp instmodsh prove ptar ptardiff shasum corelist config_data
        -cd ..\x2p && del /f find2perl s2p psed *.bat
        -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
index 07181de..8a27402 100644 (file)
@@ -541,9 +541,3 @@ podchecker: podchecker.PL ../lib/Config.pm
 
 podselect:     podselect.PL ../lib/Config.pm
        $(PERL) -I ../lib podselect.PL
-
-compile: all
-       $(REALPERL) -I../lib ../utils/perlcc pod2latex -o pod2latex.exe -v 10 -log ../compilelog
-       $(REALPERL) -I../lib ../utils/perlcc pod2man -o pod2man.exe -v 10 -log ../compilelog
-       $(REALPERL) -I../lib ../utils/perlcc pod2text -o pod2text.exe -v 10 -log ../compilelog
-       $(REALPERL) -I../lib ../utils/perlcc checkpods -o checkpods.exe -v 10 -log ../compilelog
index 1b48753..2c0b5c1 100755 (executable)
@@ -103,9 +103,6 @@ lintflags = -phbvxac
 all: $(public) $(private) $(util)
        @echo " "
 
-compile: all
-       $(REALPERL) -I../lib ../utils/perlcc -I .. -L .. $(plextract) -v -log ../compilelog;  
-
 a2p$(EXE_EXT): $(obj) a2p$(OBJ_EXT)
        $(CC) -o a2p $(LDFLAGS) $(obj) a2p$(OBJ_EXT) $(libs)