Re: [perl #22984] perl-5.8.1-RC2: TEST -bytecompile won't work at all

Message-ID: <20030718201537.GA1574@ratsnest.hole>

p4raw-id: //depot/perl@20220

13 files changed, 980 insertions, 1044 deletions

diff --git a/Makefile.SH b/Makefile.SH
index 08707c5882..8fc5caca35 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -1043,7 +1043,7 @@ makedepend: makedepend.SH config.sh
 	utest ucheck test.utf8 check.utf8 test.torture torturetest \
 	test.third check.third utest.third ucheck.third test_notty.third \
 	test.deparse test_notty.deparse test_harness test_harness_notty \
-	minitest coretest
+	test.bytecompile minitest coretest
 
 # Cannot delegate rebuilding of t/perl to make
 # to allow interlaced test and minitest
@@ -1116,6 +1116,11 @@ 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
diff --git a/bytecode.pl b/bytecode.pl
index 0fd036229c..e3759613e2 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -100,7 +100,7 @@ bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix)
     return obj;
 }
 
-void
+int
 byterun(pTHX_ register struct byteloader_state *bstate)
 {
     register int insn;
@@ -110,6 +110,7 @@ byterun(pTHX_ register struct byteloader_state *bstate)
     BYTECODE_HEADER_CHECK;	/* croak if incorrect platform */
     New(666, 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 */
 
 EOT
 
@@ -127,8 +128,11 @@ 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;
-    s/#.*//;			# remove comments
     next unless length;
     if (/^%number\s+(.*)/) {
 	$insn_num = $1;
@@ -181,6 +185,7 @@ print BYTERUN_C <<'EOT';
 	    /* NOTREACHED */
 	}
     }
+    return 0;
 }
 EOT
 
@@ -206,7 +211,7 @@ struct byteloader_state {
 
 int bl_getc(struct byteloader_fdata *);
 int bl_read(struct byteloader_fdata *, char *, size_t, size_t);
-extern void byterun(pTHX_ struct byteloader_state *);
+extern int byterun(pTHX_ struct byteloader_state *);
 
 enum {
 EOT
@@ -325,6 +330,7 @@ comment		arg			comment_t
 # Then make ord("\n") into a no-op
 %number 10
 nop		none			none
+
 # Now for the rest of the ordinary ones, beginning with \0 which is
 # ret so that \0-terminated strings can be read properly as bytecode.
 %number 0
@@ -350,8 +356,9 @@ sv_refcnt_add	SvREFCNT(bstate->bs_sv)			I32		x
 sv_flags	SvFLAGS(bstate->bs_sv)			U32
 xrv		SvRV(bstate->bs_sv)			svindex
 xpv		bstate->bs_sv				none		x
-xiv32		SvIVX(bstate->bs_sv)			I32
-xiv64		SvIVX(bstate->bs_sv)			IV64
+xpv_cur		SvCUR(bstate->bs_sv)			STRLEN
+xpv_len		SvLEN(bstate->bs_sv)			STRLEN
+xiv		SvIVX(bstate->bs_sv)			IV
 xnv		SvNVX(bstate->bs_sv)			NV
 xlv_targoff	LvTARGOFF(bstate->bs_sv)		STRLEN
 xlv_targlen	LvTARGLEN(bstate->bs_sv)		STRLEN
@@ -365,15 +372,16 @@ xio_lines	IoLINES(bstate->bs_sv)			IV
 xio_page	IoPAGE(bstate->bs_sv)			IV
 xio_page_len	IoPAGE_LEN(bstate->bs_sv)		IV
 xio_lines_left	IoLINES_LEFT(bstate->bs_sv)	       	IV
-xio_top_name	IoTOP_NAME(bstate->bs_sv)		pvcontents
+xio_top_name	IoTOP_NAME(bstate->bs_sv)		pvindex
 xio_top_gv	*(SV**)&IoTOP_GV(bstate->bs_sv)		svindex
-xio_fmt_name	IoFMT_NAME(bstate->bs_sv)		pvcontents
+xio_fmt_name	IoFMT_NAME(bstate->bs_sv)		pvindex
 xio_fmt_gv	*(SV**)&IoFMT_GV(bstate->bs_sv)		svindex
-xio_bottom_name	IoBOTTOM_NAME(bstate->bs_sv)		pvcontents
+xio_bottom_name	IoBOTTOM_NAME(bstate->bs_sv)		pvindex
 xio_bottom_gv	*(SV**)&IoBOTTOM_GV(bstate->bs_sv)	svindex
 xio_subprocess	IoSUBPROCESS(bstate->bs_sv)		short
 xio_type	IoTYPE(bstate->bs_sv)			char
 xio_flags	IoFLAGS(bstate->bs_sv)			char
+xcv_xsubany	*(SV**)&CvXSUBANY(bstate->bs_sv).any_ptr	svindex
 xcv_stash	*(SV**)&CvSTASH(bstate->bs_sv)		svindex
 xcv_start	CvSTART(bstate->bs_sv)			opindex
 xcv_root	CvROOT(bstate->bs_sv)			opindex
@@ -385,18 +393,21 @@ xcv_outside	*(SV**)&CvOUTSIDE(bstate->bs_sv)	svindex
 xcv_outside_seq	CvOUTSIDE_SEQ(bstate->bs_sv)		U32
 xcv_flags	CvFLAGS(bstate->bs_sv)			U16
 av_extend	bstate->bs_sv				SSize_t		x
+av_pushx	bstate->bs_sv				svindex		x
 av_push		bstate->bs_sv				svindex		x
 xav_fill	AvFILLp(bstate->bs_sv)			SSize_t
 xav_max		AvMAX(bstate->bs_sv)			SSize_t
 xav_flags	AvFLAGS(bstate->bs_sv)			U8
 xhv_riter	HvRITER(bstate->bs_sv)			I32
-xhv_name	HvNAME(bstate->bs_sv)			pvcontents
+xhv_name	HvNAME(bstate->bs_sv)			pvindex
+xhv_pmroot	*(OP**)&HvPMROOT(bstate->bs_sv)		opindex
 hv_store	bstate->bs_sv				svindex		x
 sv_magic	bstate->bs_sv				char		x
 mg_obj		SvMAGIC(bstate->bs_sv)->mg_obj		svindex
 mg_private	SvMAGIC(bstate->bs_sv)->mg_private	U16
 mg_flags	SvMAGIC(bstate->bs_sv)->mg_flags	U8
-mg_pv		SvMAGIC(bstate->bs_sv)			pvcontents	x
+mg_name		SvMAGIC(bstate->bs_sv)			pvcontents	x
+mg_namex	SvMAGIC(bstate->bs_sv)			svindex		x
 xmg_stash	*(SV**)&SvSTASH(bstate->bs_sv)		svindex
 gv_fetchpv	bstate->bs_sv				strconst	x
 gv_stashpv	bstate->bs_sv				strconst	x
@@ -425,12 +436,19 @@ op_first	cUNOP->op_first				opindex
 op_last		cBINOP->op_last				opindex
 op_other	cLOGOP->op_other			opindex
 op_pmreplroot	cPMOP->op_pmreplroot			opindex
-op_pmreplrootgv	*(SV**)&cPMOP->op_pmreplroot		svindex
 op_pmreplstart	cPMOP->op_pmreplstart			opindex
 op_pmnext	*(OP**)&cPMOP->op_pmnext		opindex
+#ifdef USE_ITHREADS
+op_pmstashpv	cPMOP->op_pmstashpv			pvindex
+op_pmreplrootpo	(PADOFFSET)cPMOP->op_pmreplroot		PADOFFSET
+#else
+op_pmstash	*(SV**)&cPMOP->op_pmstash		svindex
+op_pmreplrootgv	*(SV**)&cPMOP->op_pmreplroot		svindex
+#endif
 pregcomp	PL_op					pvcontents	x
 op_pmflags	cPMOP->op_pmflags			U16
 op_pmpermflags	cPMOP->op_pmpermflags			U16
+op_pmdynflags	cPMOP->op_pmdynflags			U8
 op_sv		cSVOP->op_sv				svindex
 op_padix	cPADOP->op_padix			PADOFFSET
 op_pv		cPVOP->op_pv				pvcontents
@@ -439,15 +457,36 @@ op_redoop	cLOOP->op_redoop			opindex
 op_nextop	cLOOP->op_nextop			opindex
 op_lastop	cLOOP->op_lastop			opindex
 cop_label	cCOP->cop_label				pvindex
+#ifdef USE_ITHREADS
 cop_stashpv	cCOP					pvindex		x
 cop_file	cCOP					pvindex		x
+#else
+cop_stash	cCOP					svindex		x
+cop_filegv	cCOP					svindex		x
+#endif
 cop_seq		cCOP->cop_seq				U32
 cop_arybase	cCOP->cop_arybase			I32
-cop_line	cCOP					line_t		x
+cop_line	cCOP->cop_line				line_t
+cop_io		cCOP->cop_io				svindex
 cop_warnings	cCOP->cop_warnings			svindex
 main_start	PL_main_start				opindex
 main_root	PL_main_root				opindex
+main_cv		*(SV**)&PL_main_cv			svindex
 curpad		PL_curpad				svindex		x
 push_begin	PL_beginav				svindex		x
 push_init	PL_initav				svindex		x
 push_end	PL_endav				svindex		x
+curstash	*(SV**)&PL_curstash			svindex
+defstash	*(SV**)&PL_defstash			svindex
+data		none					U8		x
+incav		*(SV**)&GvAVn(PL_incgv)			svindex
+load_glob	none					svindex		x
+#ifdef USE_ITHREADS
+regex_padav	*(SV**)&PL_regex_padav			svindex
+#endif
+dowarn		PL_dowarn				U8
+comppad_name	*(SV**)&PL_comppad_name			svindex
+xgv_stash	*(SV**)&GvSTASH(bstate->bs_sv)		svindex
+signal		bstate->bs_sv				strconst	x
+# to be removed
+formfeed	PL_formfeed				svindex
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 0decceb5ca..cfe00792d6 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -411,6 +411,44 @@ walkoptree(pTHX_ SV *opsv, char *method)
     }
 }
 
+SV **
+oplist(pTHX_ OP *o, SV **SP)
+{
+    for(; o; o = o->op_next) {
+	SV *opsv;
+	if (o->op_seq == 0) 
+	    break;
+	o->op_seq = 0;
+	opsv = sv_newmortal();
+	sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));
+	XPUSHs(opsv);
+        switch (o->op_type) {
+	case OP_SUBST:
+            SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
+            continue;
+	case OP_SORT:
+	    if (o->op_flags & (OPf_STACKED|OPf_SPECIAL)) {
+		OP *kid = cLISTOPo->op_first->op_sibling;   /* pass pushmark */
+		kid = kUNOP->op_first;                      /* pass rv2gv */
+		kid = kUNOP->op_first;                      /* pass leave */
+		SP = oplist(aTHX_ kid, SP);
+	    }
+	    continue;
+        }
+	switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
+	case OA_LOGOP:
+	    SP = oplist(aTHX_ cLOGOPo->op_other, SP);
+	    break;
+	case OA_LOOP:
+	    SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
+	    SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
+	    SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
+	    break;
+	}
+    }
+    return SP;
+}
+
 typedef OP	*B__OP;
 typedef UNOP	*B__UNOP;
 typedef BINOP	*B__BINOP;
@@ -431,6 +469,7 @@ typedef SV	*B__PVMG;
 typedef SV	*B__PVLV;
 typedef SV	*B__BM;
 typedef SV	*B__RV;
+typedef SV	*B__FM;
 typedef AV	*B__AV;
 typedef HV	*B__HV;
 typedef CV	*B__CV;
@@ -474,6 +513,7 @@ BOOT:
 #define B_sv_undef()	&PL_sv_undef
 #define B_sv_yes()	&PL_sv_yes
 #define B_sv_no()	&PL_sv_no
+#define B_formfeed()	PL_formfeed
 #ifdef USE_ITHREADS
 #define B_regex_padav()	PL_regex_padav
 #endif
@@ -533,6 +573,9 @@ B_defstash()
 U8
 B_dowarn()
 
+B::SV
+B_formfeed()
+
 void
 B_warnhook()
     CODE:
@@ -740,6 +783,12 @@ U8
 OP_private(o)
 	B::OP		o
 
+void
+OP_oplist(o)
+	B::OP		o
+    PPCODE:
+	SP = oplist(aTHX_ o, SP);
+
 #define UNOP_first(o)	o->op_first
 
 MODULE = B	PACKAGE = B::UNOP		PREFIX = UNOP_
@@ -944,6 +993,7 @@ LOOP_lastop(o)
 #define COP_stashpv(o)	CopSTASHPV(o)
 #define COP_stash(o)	CopSTASH(o)
 #define COP_file(o)	CopFILE(o)
+#define COP_filegv(o)	CopFILEGV(o)
 #define COP_cop_seq(o)	o->cop_seq
 #define COP_arybase(o)	o->cop_arybase
 #define COP_line(o)	CopLINE(o)
@@ -968,6 +1018,11 @@ char *
 COP_file(o)
 	B::COP	o
 
+B::GV
+COP_filegv(o)
+       B::COP  o
+
+
 U32
 COP_cop_seq(o)
 	B::COP	o
@@ -1307,9 +1362,13 @@ B::IO
 GvIO(gv)
 	B::GV	gv
 
-B::CV
+B::FM
 GvFORM(gv)
 	B::GV	gv
+    CODE:
+	RETVAL = (SV*)GvFORM(gv);
+    OUTPUT:
+	RETVAL
 
 B::AV
 GvAV(gv)
@@ -1465,6 +1524,12 @@ U8
 AvFLAGS(av)
 	B::AV	av
 
+MODULE = B	PACKAGE = B::FM		PREFIX = Fm
+
+IV
+FmLINES(form)
+	B::FM	form
+
 MODULE = B	PACKAGE = B::CV		PREFIX = Cv
 
 U32
diff --git a/ext/B/B/Assembler.pm b/ext/B/B/Assembler.pm
index 429405fd36..504f880a8b 100644
--- a/ext/B/B/Assembler.pm
+++ b/ext/B/B/Assembler.pm
@@ -12,8 +12,10 @@ use B::Asmdata qw(%insn_data @insn_name);
 use Config qw(%Config);
 require ByteLoader;		# we just need its $VERSIOM
 
+no warnings;			# XXX
+
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(assemble_fh newasm endasm assemble);
+@EXPORT_OK = qw(assemble_fh newasm endasm assemble asm);
 $VERSION = 0.04;
 
 use strict;
@@ -128,19 +130,12 @@ sub B::Asmdata::PUT_none {
     return "";
 }
 sub B::Asmdata::PUT_op_tr_array {
-    my $arg = shift;
-    my @ary = split(/\s*,\s*/, $arg);
-    if (@ary != 256) {
-	error "wrong number of arguments to op_tr_array";
-	@ary = (0) x 256;
-    }
-    return pack("S256", @ary);
+    my @ary = split /\s*,\s*/, shift;
+    return pack "S*", @ary;
 }
-# XXX Check this works
-# Note: $arg >> 32 is a no-op on 32-bit systems
+
 sub B::Asmdata::PUT_IV64 {
-    my $arg = shift;
-    return pack("LL", ($arg >> 16) >>16 , $arg & 0xffffffff);
+    return pack "Q", shift;
 }
 
 sub B::Asmdata::PUT_IV {
@@ -285,6 +280,18 @@ sub assemble {
     }
 }
 
+### temporary workaround
+
+sub asm {
+    return if $_[0] =~ /\s*\W/;
+    if (defined $_[1]) {
+	return if $_[1] eq "0" and $_[0] !~ /^(?:newsv|av_pushx?|xav_flags)$/;
+	return if $_[1] eq "1" and $_[0] =~ /^(?:sv_refcnt)$/;
+    }
+    # warn "@_\n";
+    assemble "@_";
+}
+
 1;
 
 __END__
diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
index d1125bdc44..164c10f0f9 100644
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -1,1001 +1,749 @@
-#      Bytecode.pm
-#
-#      Copyright (c) 1996-1998 Malcolm Beattie
-#
-#      You may distribute under the terms of either the GNU General Public
-#      License or the Artistic License, as specified in the README file.
-#
-package B::Bytecode;
+# 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.
 
-our $VERSION = '1.00';
+package B::Bytecode;
 
 use strict;
-use Carp;
-use B qw(main_cv main_root main_start comppadlist
-	 class peekop walkoptree svref_2object cstring walksymtable
-	 init_av begin_av end_av
-	 SVf_POK SVp_POK SVf_IOK SVp_IOK SVf_NOK SVp_NOK
-	 SVf_READONLY GVf_IMPORTED_AV GVf_IMPORTED_CV GVf_IMPORTED_HV
-	 GVf_IMPORTED_SV SVTYPEMASK
-	);
-use B::Asmdata qw(@optype @specialsv_name);
-use B::Assembler qw(newasm endasm assemble);
-
-my %optype_enum;
-my $i;
-for ($i = 0; $i < @optype; $i++) {
-    $optype_enum{$optype[$i]} = $i;
-}
-
-# Following is SVf_POK|SVp_POK
-# XXX Shouldn't be hardwired
-sub POK () { SVf_POK|SVp_POK }
-
-# Following is SVf_IOK|SVp_IOK
-# XXX Shouldn't be hardwired
-sub IOK () { SVf_IOK|SVp_IOK }
-
-# Following is SVf_NOK|SVp_NOK
-# XXX Shouldn't be hardwired
-sub NOK () { SVf_NOK|SVp_NOK }
-
-# nonexistant flags (see B::GV::bytecode for usage)
-sub GVf_IMPORTED_IO () { 0; }
-sub GVf_IMPORTED_FORM () { 0; }
-
-my ($verbose, $no_assemble, $debug_bc, $debug_cv);
-my @packages;	# list of packages to compile
-
-sub asm (@) {	# print replacement that knows about assembling
-    if ($no_assemble) {
-	print @_;
-    } else {
-	my $buf = join '', @_;
-	assemble($_) for (split /\n/, $buf);
-    }
-}
+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);
+no warnings;					# XXX
+
+#################################################
+
+my $ithreads = $Config{'useithreads'} eq 'define';
+my ($varix, $opix, $savebegins);
+my %strtab = (0,0);
+my %svtab = (0,0);
+my %optab = (0,0);
+my %spectab = (0,0);
+my %walked;
+my @cloop;
+my $tix = 1;
+sub asm;
+sub nice ($) { }
+my %files;
+
+#################################################
 
-sub asmf (@) {	# printf replacement that knows about assembling
-    if ($no_assemble) {
-	printf shift(), @_;
-    } else {
-	my $format = shift;
-	my $buf = sprintf $format, @_;
-	assemble($_) for (split /\n/, $buf);
-    }
+sub pvstring {
+    my $pv = shift;
+    defined($pv) ? cstring ($pv."\0") : "\"\"";
 }
 
-# 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 ($compress_nullops, $omit_seq, $bypass_nullops);
-my %optimise = (compress_nullops	=> \$compress_nullops,
-		omit_sequence_numbers	=> \$omit_seq,
-		bypass_nullops		=> \$bypass_nullops);
-
-my $strip_syntree;	# this is left here in case stripping the
-			# syntree ever becomes safe again
-			#	-- BKS, June 2000
-
-my $nextix = 0;
-my %symtable;	# maps object addresses to object indices.
-		# Filled in at allocation (newsv/newop) time.
-
-my %saved;	# maps object addresses (for SVish classes) to "saved yet?"
-		# flag. Set at FOO::bytecode time usually by SV::bytecode.
-		# Manipulated via saved(), mark_saved(), unmark_saved().
-
-my %strtable;	# maps shared strings to object indices
-		# Filled in at allocation (pvix) time
-
-my $svix = -1;	# we keep track of when the sv register contains an element
-		# of the object table to avoid unnecessary repeated
-		# consecutive ldsv instructions.
-
-my $opix = -1;	# Ditto for the op register.
-
-sub ldsv {
-    my $ix = shift;
-    if ($ix != $svix) {
-	asm "ldsv $ix\n";
-	$svix = $ix;
+sub pvix {
+    my $str = pvstring shift;
+    my $ix = $strtab{$str};
+    defined($ix) ? $ix : do {
+	asm "newpv", $str;
+	asm "stpv", $strtab{$str} = $tix;
+	$tix++;
     }
 }
 
-sub stsv {
-    my $ix = shift;
-    asm "stsv $ix\n";
-    $svix = $ix;
-}
-
-sub set_svix {
-    $svix = shift;
-}
-
-sub ldop {
-    my $ix = shift;
-    if ($ix != $opix) {
-	asm "ldop $ix\n";
-	$opix = $ix;
+sub B::OP::ix {
+    my $op = shift;
+    my $ix = $optab{$$op};
+    defined($ix) ? $ix : do {
+	nice '['.$op->name.']';
+	asm "newop", $op->size;
+	asm "stop", $optab{$$op} = $opix = $ix = $tix++;
+	$op->bsave($ix);
+	$ix;
     }
 }
 
-sub stop {
-    my $ix = shift;
-    asm "stop $ix\n";
-    $opix = $ix;
+sub B::SPECIAL::ix {
+    my $spec = shift;
+    my $ix = $spectab{$$spec};
+    defined($ix) ? $ix : do {
+	nice '['.$specialsv_name[$$spec].']';
+	asm "ldspecsv", $$spec;
+	asm "stsv", $spectab{$$spec} = $varix = $tix;
+	$tix++;
+    }
 }
 
-sub set_opix {
-    $opix = shift;
+sub B::SV::ix {
+    my $sv = shift;
+    my $ix = $svtab{$$sv};
+    defined($ix) ? $ix : do {
+	nice '['.class($sv).']';
+	asm "newsv", $sv->SvTYPE;
+	asm "stsv", $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_fetchpv", cstring $name;
+	    asm "stsv", $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;
+
+    # TODO: kludge
+	    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 "newsv", SVt_PVGV;
+	    asm "stsv", $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 pvstring {
-    my $str = shift;
-    if (defined($str)) {
-	return cstring($str . "\0");
-    } else {
-	return '""';
+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_stashpv", cstring $name;
+	    asm "stsv", $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 "newsv", SVt_PVHV;
+	    asm "stsv", $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;
+	    asm "xnv", $hv->NVX;
+	    asm "xmg_stash", $stashix;
+	}
+	asm "sv_refcnt", $hv->REFCNT;
+	asm "sv_flags", $hv->FLAGS;
+	$ix;
     }
 }
 
-sub nv {
-    # print full precision
-    my $str = sprintf "%.40f", $_[0];
-    $str =~ s/0+$//;		# remove trailing zeros
-    $str =~ s/\.$/.0/;
-    return $str;
+sub B::NULL::ix {
+    my $sv = shift;
+    $$sv ? $sv->B::SV::ix : 0;
 }
 
-sub saved { $saved{${$_[0]}} }
-sub mark_saved { $saved{${$_[0]}} = 1 }
-sub unmark_saved { $saved{${$_[0]}} = 0 }
+sub B::NULL::opwalk { 0 }
 
-sub debug { $debug_bc = shift }
+#################################################
 
-sub pvix {	# save a shared PV (mainly for COPs)
-    return $strtable{$_[0]} if defined($strtable{$_[0]});
-    asmf "newpv %s\n", pvstring($_[0]);
-    my $ix = $nextix++;
-    $strtable{$_[0]} = $ix;
-    asmf "stpv %d\n", $ix;
-    return $ix;
-}
+sub B::NULL::bsave {
+    my ($sv,$ix) = @_;
 
-sub B::OBJECT::nyi {
-    my $obj = shift;
-    warn sprintf("bytecode save method for %s (0x%x) not yet implemented\n",
-		 class($obj), $$obj);
+    nice '-'.class($sv).'-',
+    asm "ldsv", $varix = $ix unless $ix == $varix;
+    asm "sv_refcnt", $sv->REFCNT;
+    asm "sv_flags", $sv->FLAGS;
 }
 
-#
-# objix may stomp on the op register (for op objects)
-# or the sv register (for SV objects)
-#
-sub B::OBJECT::objix {
-    my $obj = shift;
-    my $ix = $symtable{$$obj};
-    if (defined($ix)) {
-	return $ix;
-    } else {
-	$obj->newix($nextix);
-	return $symtable{$$obj} = $nextix++;
-    }
-}
+sub B::SV::bsave;
+    *B::SV::bsave = *B::NULL::bsave;
 
-sub B::SV::newix {
-    my ($sv, $ix) = @_;
-    asmf "newsv %d\t# %s\n", $sv->FLAGS & SVTYPEMASK, class($sv);
-    stsv($ix);    
+sub B::RV::bsave {
+    my ($sv,$ix) = @_;
+    my $rvix = $sv->RV->ix;
+    $sv->B::NULL::bsave($ix);
+    asm "xrv", $rvix;
 }
 
-sub B::GV::newix {
-    my ($gv, $ix) = @_;
-    my $gvname = $gv->NAME;
-    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
-    asm "gv_fetchpv $name\n";
-    stsv($ix);
+sub B::PV::bsave {
+    my ($sv,$ix) = @_;
+    $sv->B::NULL::bsave($ix);
+    asm "newpv", pvstring $sv->PVBM;
+    asm "xpv";
 }
 
-sub B::HV::newix {
-    my ($hv, $ix) = @_;
-    my $name = $hv->NAME;
-    if ($name) {
-	# It's a stash
-	asmf "gv_stashpv %s\n", cstring($name);
-	stsv($ix);
-    } else {
-	# It's an ordinary HV. Fall back to ordinary newix method
-	$hv->B::SV::newix($ix);
-    }
+sub B::IV::bsave {
+    my ($sv,$ix) = @_;
+    $sv->B::NULL::bsave($ix);
+    asm "xiv", $sv->IVX;
 }
 
-sub B::SPECIAL::newix {
-    my ($sv, $ix) = @_;
-    # Special case. $$sv is not the address of the SV but an
-    # index into svspecialsv_list.
-    asmf "ldspecsv $$sv\t# %s\n", $specialsv_name[$$sv];
-    stsv($ix);
+sub B::NV::bsave {
+    my ($sv,$ix) = @_;
+    $sv->B::NULL::bsave($ix);
+    asm "xnv", sprintf "%.40g", $sv->NVX;
 }
 
-sub B::OP::newix {
-    my ($op, $ix) = @_;
-    my $class = class($op);
-    my $typenum = $optype_enum{$class};
-    croak("OP::newix: can't understand class $class") unless defined($typenum);
-    asm "newop $typenum\t# $class\n";
-    stop($ix);
+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);
+    asm "xiv", !$ithreads && $sv->FLAGS & (SVf_FAKE|SVf_READONLY) ?
+	"0 but true" : $sv->IVX;
 }
 
-sub B::OP::walkoptree_debug {
-    my $op = shift;
-    warn(sprintf("walkoptree: %s\n", peekop($op)));
+sub B::PVNV::bsave {
+    my ($sv,$ix) = @_;
+    $sv->B::PVIV::bsave($ix);
+    asm "xnv", sprintf "%.40g", $sv->NVX;
 }
 
-sub B::OP::bytecode {
-    my $op = shift;
-    my $next = $op->next;
-    my $nextix;
-    my $sibix = $op->sibling->objix unless $strip_syntree;
-    my $ix = $op->objix;
-    my $type = $op->type;
-
-    if ($bypass_nullops) {
-	$next = $next->next while $$next && $next->type == 0;
+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;
     }
-    $nextix = $next->objix;
-
-    asmf "# %s\n", peekop($op) if $debug_bc;
-    ldop($ix);
-    asm "op_next $nextix\n";
-    asm "op_sibling $sibix\n" unless $strip_syntree;
-    asmf "op_type %s\t# %d\n", "pp_" . $op->name, $type;
-    asmf("op_seq %d\n", $op->seq) unless $omit_seq;
-    if ($type || !$compress_nullops) {
-	asmf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n",
-	    $op->targ, $op->flags, $op->private;
-    }
-}
 
-sub B::UNOP::bytecode {
-    my $op = shift;
-    my $firstix = $op->first->objix unless $strip_syntree;
-    $op->B::OP::bytecode;
-    if (($op->type || !$compress_nullops) && !$strip_syntree) {
-	asm "op_first $firstix\n";
+    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::LOGOP::bytecode {
-    my $op = shift;
-    my $otherix = $op->other->objix;
-    $op->B::UNOP::bytecode;
-    asm "op_other $otherix\n";
+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 $startix = $cv->START->opwalk;
+    my $rootix = $cv->ROOT->ix;
+    my $gvix = $cv->GV->ix;
+    my $padlistix = $cv->PADLIST->ix;
+    my $outsideix = $cv->OUTSIDE->ix;
+    my $constix = $cv->CONST ? $cv->XSUBANY->ix : 0;
+
+    $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;
+    asm "av_pushx", $_ for @array;
+    asm "sv_refcnt", $av->REFCNT;
+    asm "sv_flags", $av->FLAGS;
+    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::SVOP::bytecode {
-    my $op = shift;
-    my $sv = $op->sv;
-    my $svix = $sv->objix;
-    $op->B::OP::bytecode;
-    asm "op_sv $svix\n";
-    $sv->bytecode;
+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_fetchpv", cstring $hv->NAME . "::$k";
+	    asm "stsv", $svtab{$$v} = $varix = $tix;
+	    $v->bsave($tix++);
+	}
+    }
 }
 
-sub B::PADOP::bytecode {
-    my $op = shift;
-    my $padix = $op->padix;
-    $op->B::OP::bytecode;
-    asm "op_padix $padix\n";
-}
+######################################################
 
-sub B::PVOP::bytecode {
-    my $op = shift;
-    my $pv = $op->pv;
-    $op->B::OP::bytecode;
-    #
-    # This would be easy except that OP_TRANS uses a PVOP to store an
-    # endian-dependent array of 256 shorts instead of a plain string.
-    #
-    if ($op->name eq "trans") {
-	my @shorts = unpack("s256", $pv); # assembler handles endianness
-	asm "op_pv_tr ", join(",", @shorts), "\n";
-    } else {
-	asmf "newpv %s\nop_pv\n", pvstring($pv);
-    }
-}
 
-sub B::BINOP::bytecode {
-    my $op = shift;
-    my $lastix = $op->last->objix unless $strip_syntree;
-    $op->B::UNOP::bytecode;
-    if (($op->type || !$compress_nullops) && !$strip_syntree) {
-	asm "op_last $lastix\n";
+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_type", $op->type;
+    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::LOOP::bytecode {
-    my $op = shift;
-    my $redoopix = $op->redoop->objix;
-    my $nextopix = $op->nextop->objix;
-    my $lastopix = $op->lastop->objix;
-    $op->B::LISTOP::bytecode;
-    asm "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n";
-}
+sub B::OP::bsave;
+    *B::OP::bsave = *B::OP::bsave_thin;
 
-sub B::COP::bytecode {
-    my $op = shift;
-    my $file = $op->file;
-    my $line = $op->line;
-    if ($debug_bc) { # do this early to aid debugging
-	asmf "# line %s:%d\n", $file, $line;
-    }
-    my $stashpv = $op->stashpv;
-    my $warnings = $op->warnings;
-    my $warningsix = $warnings->objix;
-    my $labelix = pvix($op->label);
-    my $stashix = pvix($stashpv);
-    my $fileix = pvix($file);
-    $warnings->bytecode;
-    $op->B::OP::bytecode;
-    asmf <<"EOT", $labelix, $stashix, $op->cop_seq, $fileix, $op->arybase;
-cop_label %d
-cop_stashpv %d
-cop_seq %d
-cop_file %d
-cop_arybase %d
-cop_line $line
-cop_warnings $warningsix
-EOT
-}
-
-sub B::PMOP::bytecode {
-    my $op = shift;
-    my $replroot = $op->pmreplroot;
-    my $replrootix = $replroot->objix;
-    my $replstartix = $op->pmreplstart->objix;
-    my $opname = $op->name;
-    # pmnext is corrupt in some PMOPs (see misc.t for example)
-    #my $pmnextix = $op->pmnext->objix;
-
-    if ($$replroot) {
-	# OP_PUSHRE (a mutated version of OP_MATCH for the regexp
-	# argument to a split) stores a GV in op_pmreplroot instead
-	# of a substitution syntax tree. We don't want to walk that...
-	if ($opname eq "pushre") {
-	    $replroot->bytecode;
-	} else {
-	    walkoptree($replroot, "bytecode");
-	}
-    }
-    $op->B::LISTOP::bytecode;
-    if ($opname eq "pushre") {
-	asmf "op_pmreplrootgv $replrootix\n";
+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 =~ /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;
+    *B::BINOP::bsave = *B::OP::bsave;
+
+# deal with sort / formline 
+
+sub B::LISTOP::bsave {
+    my ($op, $ix) = @_;
+    my $name = $op->name;
+    if ($name eq 'sort' && $op->flags & (OPf_SPECIAL|OPf_STACKED)) {
+	my $first = $op->first;
+	my $firstix = $first->ix;
+	my $firstsiblix = do {
+	    local *B::UNOP::bsave = *B::UNOP::bsave_fat;
+	    local *B::LISTOP::bsave = *B::UNOP::bsave_fat;
+	    $first->sibling->ix;
+	};
+	asm "ldop", $firstix unless $firstix == $opix;
+	asm "op_sibling", $firstsiblix;
+	$op->B::OP::bsave($ix);
+	asm "op_first", $firstix;
+    } elsif ($name eq 'formline') {
+	$op->B::UNOP::bsave_fat($ix);
     } else {
-	asm "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n";
+	$op->B::OP::bsave($ix);
     }
-    my $re = pvstring($op->precomp);
-    # op_pmnext omitted since a perl bug means it's sometime corrupt
-    asmf <<"EOT", $op->pmflags, $op->pmpermflags;
-op_pmflags 0x%x
-op_pmpermflags 0x%x
-newpv $re
-pregcomp
-EOT
 }
 
-sub B::SV::bytecode {
-    my $sv = shift;
-    return if saved($sv);
-    my $ix = $sv->objix;
-    my $refcnt = $sv->REFCNT;
-    my $flags = sprintf("0x%x", $sv->FLAGS);
-    ldsv($ix);
-    asm "sv_refcnt $refcnt\nsv_flags $flags\n";
-    mark_saved($sv);
-}
+# fat versions
 
-sub B::PV::bytecode {
-    my $sv = shift;
-    return if saved($sv);
-    $sv->B::SV::bytecode;
-    asmf("newpv %s\nxpv\n", pvstring($sv->PV)) if $sv->FLAGS & POK;
-}
-
-sub B::IV::bytecode {
-    my $sv = shift;
-    return if saved($sv);
-    my $iv = $sv->IVX;
-    $sv->B::SV::bytecode;
-    asmf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32" if $sv->FLAGS & IOK; # could be PVNV
-}
+sub B::OP::bsave_fat {
+    my ($op, $ix) = @_;
+    my $siblix = $op->sibling->ix;
 
-sub B::NV::bytecode {
-    my $sv = shift;
-    return if saved($sv);
-    $sv->B::SV::bytecode;
-    asmf "xnv %s\n", nv($sv->NVX);
+    $op->B::OP::bsave_thin($ix);
+    asm "op_sibling", $siblix;
+    # asm "op_seq", -1;			XXX don't allocate OPs piece by piece
 }
 
-sub B::RV::bytecode {
-    my $sv = shift;
-    return if saved($sv);
-    my $rv = $sv->RV;
-    my $rvix = $rv->objix;
-    $rv->bytecode;
-    $sv->B::SV::bytecode;
-    asm "xrv $rvix\n";
-}
+sub B::UNOP::bsave_fat {
+    my ($op,$ix) = @_;
+    my $firstix = $op->first->ix;
 
-sub B::PVIV::bytecode {
-    my $sv = shift;
-    return if saved($sv);
-    my $iv = $sv->IVX;
-    $sv->B::PV::bytecode;
-    asmf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
+    $op->B::OP::bsave($ix);
+    asm "op_first", $firstix;
 }
 
-sub B::PVNV::bytecode {
-    my $sv = shift;
-    my $flag = shift || 0;
-    # The $flag argument is passed through PVMG::bytecode by BM::bytecode
-    # and AV::bytecode and indicates special handling. $flag = 1 is used by
-    # BM::bytecode and means that we should ensure we save the whole B-M
-    # table. It consists of 257 bytes (256 char array plus a final \0)
-    # which follow the ordinary PV+\0 and the 257 bytes are *not* reflected
-    # in SvCUR. $flag = 2 is used by AV::bytecode and means that we only
-    # call SV::bytecode instead of saving PV and calling NV::bytecode since
-    # PV/NV/IV stuff is different for AVs.
-    return if saved($sv);
-    if ($flag == 2) {
-	$sv->B::SV::bytecode;
-    } else {
-	my $pv = $sv->PV;
-	$sv->B::IV::bytecode;
-	asmf "xnv %s\n", nv($sv->NVX);
-	if ($flag == 1) {
-	    $pv .= "\0" . $sv->TABLE;
-	    asmf "newpv %s\npv_cur %d\nxpv\n", pvstring($pv),length($pv)-257;
-	} else {
-	    asmf("newpv %s\nxpv\n", pvstring($pv)) if $sv->FLAGS & POK;
-	}
+sub B::BINOP::bsave_fat {
+    my ($op,$ix) = @_;
+    my $last = $op->last;
+    my $lastix = $op->last->ix;
+    if ($] < 5.009 && $op->name eq 'aassign' && $last->name eq 'null') {
+	asm "ldop", $lastix unless $lastix == $opix;
+	asm "op_targ", $last->targ;
     }
-}
 
-sub B::PVMG::bytecode {
-    my ($sv, $flag) = @_;
-    # See B::PVNV::bytecode for an explanation of $flag.
-    return if saved($sv);
-    # XXX We assume SvSTASH is already saved and don't save it later ourselves
-    my $stashix = $sv->SvSTASH->objix;
-    my @mgchain = $sv->MAGIC;
-    my (@mgobjix, $mg);
-    #
-    # We need to traverse the magic chain and get objix for each OBJ
-    # field *before* we do B::PVNV::bytecode since objix overwrites
-    # the sv register. However, we need to write the magic-saving
-    # bytecode *after* B::PVNV::bytecode since sv isn't initialised
-    # to refer to $sv until then.
-    #
-    @mgobjix = map($_->OBJ->objix, @mgchain);
-    $sv->B::PVNV::bytecode($flag);
-    asm "xmg_stash $stashix\n";
-    foreach $mg (@mgchain) {
-	asmf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n",
-	    cstring($mg->TYPE), shift(@mgobjix), pvstring($mg->PTR);
-    }
+    $op->B::UNOP::bsave($ix);
+    asm "op_last", $lastix;
 }
 
-sub B::PVLV::bytecode {
-    my $sv = shift;
-    return if saved($sv);
-    $sv->B::PVMG::bytecode;
-    asmf <<'EOT', $sv->TARGOFF, $sv->TARGLEN, cstring($sv->TYPE);
-xlv_targoff %d
-xlv_targlen %d
-xlv_type %s
-EOT
-}
+sub B::LOGOP::bsave {
+    my ($op,$ix) = @_;
+    my $otherix = $op->other->ix;
 
-sub B::BM::bytecode {
-    my $sv = shift;
-    return if saved($sv);
-    # See PVNV::bytecode for an explanation of what the argument does
-    $sv->B::PVMG::bytecode(1);
-    asmf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n",
-	$sv->USEFUL, $sv->PREVIOUS, $sv->RARE;
+    $op->B::UNOP::bsave($ix);
+    asm "op_other", $otherix;
 }
 
-sub empty_gv {	# is a GV empty except for imported stuff?
-    my $gv = shift;
+sub B::PMOP::bsave {
+    my ($op,$ix) = @_;
+    my ($rrop, $rrarg, $rstart);
 
-    return 0 if ($gv->SV->FLAGS & SVTYPEMASK);	# sv not SVt_NULL
-    my @subfield_names = qw(AV HV CV FORM IO);
-    @subfield_names = grep {;
-				no strict 'refs';
-				!($gv->GvFLAGS & ${\"GVf_IMPORTED_$_"}->()) && ${$gv->$_()};
-			} @subfield_names;
-    return scalar @subfield_names;
-}
+    # my $pmnextix = $op->pmnext->ix;	# XXX
 
-sub B::GV::bytecode {
-    my $gv = shift;
-    return if saved($gv);
-    return unless grep { $_ eq $gv->STASH->NAME; } @packages;
-    return if $gv->NAME =~ m/^\(/;	# ignore overloads - they'll be rebuilt
-    my $ix = $gv->objix;
-    mark_saved($gv);
-    ldsv($ix);
-    asmf <<"EOT", $gv->FLAGS, $gv->GvFLAGS;
-sv_flags 0x%x
-xgv_flags 0x%x
-EOT
-    my $refcnt = $gv->REFCNT;
-    asmf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
-    return if $gv->is_empty;
-    asmf <<"EOT", $gv->LINE, pvix($gv->FILE);
-gp_line %d
-gp_file %d
-EOT
-    my $gvname = $gv->NAME;
-    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
-    my $egv = $gv->EGV;
-    my $egvix = $egv->objix;
-    my $gvrefcnt = $gv->GvREFCNT;
-    asmf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1;
-    if ($gvrefcnt > 1 &&  $ix != $egvix) {
-	asm "gp_share $egvix\n";
-    } else {
-	if ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
-	    my $i;
-	    my @subfield_names = qw(SV AV HV CV FORM IO);
-	    @subfield_names = grep {;
-					no strict 'refs';
-					!($gv->GvFLAGS & ${\"GVf_IMPORTED_$_"}->());
-				} @subfield_names;
-	    my @subfields = map($gv->$_(), @subfield_names);
-	    my @ixes = map($_->objix, @subfields);
-	    # Reset sv register for $gv
-	    ldsv($ix);
-	    for ($i = 0; $i < @ixes; $i++) {
-		asmf "gp_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
-	    }
-	    # Now save all the subfields
-	    my $sv;
-	    foreach $sv (@subfields) {
-		$sv->bytecode;
-	    }
+    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::HV::bytecode {
-    my $hv = shift;
-    return if saved($hv);
-    mark_saved($hv);
-    my $name = $hv->NAME;
-    my $ix = $hv->objix;
-    if (!$name) {
-	# It's an ordinary HV. Stashes have NAME set and need no further
-	# saving beyond the gv_stashpv that $hv->objix already ensures.
-	my @contents = $hv->ARRAY;
-	my ($i, @ixes);
-	for ($i = 1; $i < @contents; $i += 2) {
-	    push(@ixes, $contents[$i]->objix);
-	}
-	for ($i = 1; $i < @contents; $i += 2) {
-	    $contents[$i]->bytecode;
-	}
-	ldsv($ix);
-	for ($i = 0; $i < @contents; $i += 2) {
-	    asmf("newpv %s\nhv_store %d\n",
-		   pvstring($contents[$i]), $ixes[$i / 2]);
-	}
-	asmf "sv_refcnt %d\nsv_flags 0x%x\n", $hv->REFCNT, $hv->FLAGS;
-    }
+sub B::SVOP::bsave {
+    my ($op,$ix) = @_;
+    my $svix = $op->sv->ix;
+
+    $op->B::OP::bsave($ix);
+    asm "op_sv", $svix;
 }
 
-sub B::AV::bytecode {
-    my $av = shift;
-    return if saved($av);
-    my $ix = $av->objix;
-    my $fill = $av->FILL;
-    my $max = $av->MAX;
-    my (@array, @ixes);
-    if ($fill > -1) {
-	@array = $av->ARRAY;
-	@ixes = map($_->objix, @array);
-	my $sv;
-	foreach $sv (@array) {
-	    $sv->bytecode;
-	}
-    }
-    # See PVNV::bytecode for the meaning of the flag argument of 2.
-    $av->B::PVMG::bytecode(2);
-    # Recover sv register and set AvMAX and AvFILL to -1 (since we
-    # create an AV with NEWSV and SvUPGRADE rather than doing newAV
-    # which is what sets AvMAX and AvFILL.
-    ldsv($ix);
-    asmf "sv_flags 0x%x\n", $av->FLAGS & ~SVf_READONLY; # SvREADONLY_off($av) in case PADCONST
-    asmf "xav_flags 0x%x\nxav_max -1\nxav_fill -1\n", $av->AvFLAGS;
-    if ($fill > -1) {
-	my $elix;
-	foreach $elix (@ixes) {
-	    asm "av_push $elix\n";
-	}
-    } else {
-	if ($max > -1) {
-	    asm "av_extend $max\n";
-	}
-    }
-    asmf "sv_flags 0x%x\n", $av->FLAGS; # restore flags from above
-}
-
-sub B::CV::bytecode {
-    my $cv = shift;
-    return if saved($cv);
-    return if ${$cv->GV} && ($cv->GV->GvFLAGS & GVf_IMPORTED_CV);
-    my $fileix = pvix($cv->FILE);
-    my $ix = $cv->objix;
-    $cv->B::PVMG::bytecode;
-    my $i;
-    my @subfield_names = qw(ROOT START STASH GV PADLIST OUTSIDE);
-    my @subfields = map($cv->$_(), @subfield_names);
-    my @ixes = map($_->objix, @subfields);
-    # Save OP tree from CvROOT (first element of @subfields)
-    my $root = shift @subfields;
-    if ($$root) {
-	walkoptree($root, "bytecode");
-    }
-    # Reset sv register for $cv (since above ->objix calls stomped on it)
-    ldsv($ix);
-    for ($i = 0; $i < @ixes; $i++) {
-	asmf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
-    }
-    asmf "xcv_depth %d\nxcv_flags 0x%x\nxcv_outside_seq 0x%x",
-	$cv->DEPTH, $cv->CvFLAGS, $cv->OUTSIDE_SEQ;
-    asmf "xcv_file %d\n", $fileix;
-    # Now save all the subfields (except for CvROOT which was handled
-    # above) and CvSTART (now the initial element of @subfields).
-    shift @subfields; # bye-bye CvSTART
-    my $sv;
-    foreach $sv (@subfields) {
-	$sv->bytecode;
-    }
+sub B::PADOP::bsave {
+    my ($op,$ix) = @_;
+
+    $op->B::OP::bsave($ix);
+    asm "op_padix", $op->padix;
 }
 
-sub B::IO::bytecode {
-    my $io = shift;
-    return if saved($io);
-    my $ix = $io->objix;
-    my $top_gv = $io->TOP_GV;
-    my $top_gvix = $top_gv->objix;
-    my $fmt_gv = $io->FMT_GV;
-    my $fmt_gvix = $fmt_gv->objix;
-    my $bottom_gv = $io->BOTTOM_GV;
-    my $bottom_gvix = $bottom_gv->objix;
-
-    $io->B::PVMG::bytecode;
-    ldsv($ix);
-    asm "xio_top_gv $top_gvix\n";
-    asm "xio_fmt_gv $fmt_gvix\n";
-    asm "xio_bottom_gv $bottom_gvix\n";
-    my $field;
-    foreach $field (qw(TOP_NAME FMT_NAME BOTTOM_NAME)) {
-	asmf "newpv %s\nxio_%s\n", pvstring($io->$field()), lc($field);
-    }
-    foreach $field (qw(LINES PAGE PAGE_LEN LINES_LEFT SUBPROCESS)) {
-	asmf "xio_%s %d\n", lc($field), $io->$field();
+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";
     }
-    asmf "xio_type %s\nxio_flags 0x%x\n", cstring($io->IoTYPE), $io->IoFLAGS;
-    $top_gv->bytecode;
-    $fmt_gv->bytecode;
-    $bottom_gv->bytecode;
 }
 
-sub B::SPECIAL::bytecode {
-    # nothing extra needs doing
+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 bytecompile_object {
-    for my $sv (@_) {
-	svref_2object($sv)->bytecode;
+sub B::COP::bsave {
+    my ($cop,$ix) = @_;
+    my $warnix = $cop->warnings->ix;
+    my $ioix = $cop->io->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;
+    asm "cop_io", $ioix;
 }
 
-sub B::GV::bytecodecv {
-    my $gv = shift;
-    my $cv = $gv->CV;
-    if ($$cv && !saved($cv) && !($gv->FLAGS & GVf_IMPORTED_CV)) {
-	if ($debug_cv) {
-	    warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
-			 $gv->STASH->NAME, $gv->NAME, $$cv, $$gv);
+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}};
 	}
-	$gv->bytecode;
+	$ix;
     }
 }
 
-sub save_call_queues {
-    if (begin_av()->isa("B::AV")) {	# this is just to save 'use Foo;' calls
-	for my $cv (begin_av()->ARRAY) {
-	    next unless grep { $_ eq $cv->STASH->NAME; } @packages;
-	    my $op = $cv->START;
-OPLOOP:
-	    while ($$op) {
-	 	if ($op->name eq 'require') { # save any BEGIN that does a require
-		    $cv->bytecode;
-		    asmf "push_begin %d\n", $cv->objix;
-		    last OPLOOP;
+#################################################
+
+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 { exit while 1 }
+		for (my $op = $_->START; $$op; $op = $op->next) {
+		    next unless $op->name =~ /require/;
+		    asm "push_begin", $_->ix;
+		    last;
 		}
-		$op = $op->next;
 	    }
 	}
     }
-    if (init_av()->isa("B::AV")) {
-	for my $cv (init_av()->ARRAY) {
-	    next unless grep { $_ eq $cv->STASH->NAME; } @packages;
-	    $cv->bytecode;
-	    asmf "push_init %d\n", $cv->objix;
+    if (($av=init_av)->isa("B::AV")) {
+	for ($av->ARRAY) {
+	    next unless $_->FILE eq $0;
+	    asm "push_init", $_->ix;
 	}
     }
-    if (end_av()->isa("B::AV")) {
-	for my $cv (end_av()->ARRAY) {
-	    next unless grep { $_ eq $cv->STASH->NAME; } @packages;
-	    $cv->bytecode;
-	    asmf "push_end %d\n", $cv->objix;
+    if (($av=end_av)->isa("B::AV")) {
+	for ($av->ARRAY) {
+	    next unless $_->FILE eq $0;
+	    asm "push_end", $_->ix;
 	}
     }
 }
 
-sub symwalk {
-    no strict 'refs';
-    my $ok = 1 if grep { (my $name = $_[0]) =~ s/::$//; $_ eq $name;} @packages;
-    if (grep { /^$_[0]/; } @packages) {
-	walksymtable(\%{"$_[0]"}, "bytecodecv", \&symwalk, $_[0]);
-    }
-    warn "considering $_[0] ... " . ($ok ? "accepted\n" : "rejected\n")
-	if $debug_bc;
-    $ok;
-}
-
-sub bytecompile_main {
-    my $curpad = (comppadlist->ARRAY)[1];
-    my $curpadix = $curpad->objix;
-    $curpad->bytecode;
-    save_call_queues();
-    walkoptree(main_root, "bytecode") unless ref(main_root) eq "B::NULL";
-    warn "done main program, now walking symbol table\n" if $debug_bc;
-    if (@packages) {
-	no strict qw(refs);
-	walksymtable(\%{"main::"}, "bytecodecv", \&symwalk);
-    } else {
-	die "No packages requested for compilation!\n";
-    }
-    asmf "main_root %d\n", main_root->objix;
-    asmf "main_start %d\n", main_start->objix;
-    asmf "curpad $curpadix\n";
-    # XXX Do min_intro_pending and max_intro_pending matter?
-}
-
 sub compile {
-    my @options = @_;
-    my ($option, $opt, $arg);
-    open(OUT, ">&STDOUT");
-    binmode OUT;
-    select OUT;
-  OPTION:
-    while ($option = shift @options) {
-	if ($option =~ /^-(.)(.*)/) {
-	    $opt = $1;
-	    $arg = $2;
+    my ($head, $scan, $T_inhinc, $T_thatfile, $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(.*)$/) {
+	    my $ofile = $1;
+	    open STDOUT, ">$ofile" or die "open $ofile: $!";
+	    *B::COP::file = sub { $ofile } if $T_thatfile;
+	} elsif (/^-f(.*)$/) {
+	    $files{$1} = 1;
+	} elsif (/^-s/) {
+	    $scan = 1;
+	} elsif (/^-b/) {
+	    $savebegins = 1;
+    # these are here for the testsuite
+	} elsif (/^-TD(.*)/) {
+	    $T_inhinc = 1;
+	    $cwd = $1;
+	} elsif (/^-TF/) {
+	    $T_thatfile = 1;
 	} else {
-	    unshift @options, $option;
-	    last OPTION;
+	    bwarn "Ignoring '$_' option";
 	}
-	if ($opt eq "-" && $arg eq "-") {
-	    shift @options;
-	    last OPTION;
-	} elsif ($opt eq "o") {
-	    $arg ||= shift @options;
-	    open(OUT, ">$arg") or return "$arg: $!\n";
-	    binmode OUT;
-	} elsif ($opt eq "a") {
-	    $arg ||= shift @options;
-	    open(OUT, ">>$arg") or return "$arg: $!\n";
-	    binmode OUT;
-	} elsif ($opt eq "D") {
-	    $arg ||= shift @options;
-	    foreach $arg (split(//, $arg)) {
-		if ($arg eq "b") {
-		    $| = 1;
-		    debug(1);
-		} elsif ($arg eq "o") {
-		    B->debug(1);
-		} elsif ($arg eq "a") {
-		    B::Assembler::debug(1);
-		} elsif ($arg eq "C") {
-		    $debug_cv = 1;
+    }
+    if ($scan) {
+	for(keys %files) {
+	    my $f;
+	    # KLUDGE
+	    open($f, $_) or open ($f, "$cwd/$_")
+		or bwarn("cannot rescan '$_'"), next;
+	    while (<$f>) {
+		/^#\s*line\s+\d+\s+("?)(.*)\1/ and $files{$2} = 1;
+		/^#/ and next;
+		if (/\bgoto\b/ && !$keep_syn) {
+		    bwarn "keeping the syntax tree: \"goto\" op found";
+		    keep_syn;
 		}
 	    }
-	} elsif ($opt eq "v") {
-	    $verbose = 1;
-	} elsif ($opt eq "S") {
-	    $no_assemble = 1;
-	} elsif ($opt eq "f") {
-	    $arg ||= shift @options;
-	    my $value = $arg !~ s/^no-//;
-	    $arg =~ s/-/_/g;
-	    my $ref = $optimise{$arg};
-	    if (defined($ref)) {
-		$$ref = $value;
+	    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"};
+	    local undef $/;
+	    if (length (my $data = <$dh>)) {
+		asm "data", ord 'D';
+		print $data;
 	    } else {
-		warn qq(ignoring unknown optimisation option "$arg"\n);
+		asm "ret";
 	    }
-	} elsif ($opt eq "O") {
-	    $arg = 1 if $arg eq "";
-	    my $ref;
-	    foreach $ref (values %optimise) {
-		$$ref = 0;
-	    }
-	    if ($arg >= 2) {
-		$bypass_nullops = 1;
-	    }
-	    if ($arg >= 1) {
-		$compress_nullops = 1;
-		$omit_seq = 1;
-	    }
-	} elsif ($opt eq "u") {
-	    $arg ||= shift @options;
-	    push @packages, $arg;
-	} else {
-	    warn qq(ignoring unknown option "$opt$arg"\n);
 	}
-    }
-    if (! @packages) {
-	warn "No package specified for compilation, assuming main::\n";
-	@packages = qw(main);
-    }
-    if (@options) {
-	die "Extraneous options left on B::Bytecode commandline: @options\n";
-    } else {
-	return sub { 
-	    newasm(\&apr) unless $no_assemble;
-	    bytecompile_main();
-	    endasm() unless $no_assemble;
-	};
+
+	endasm;
     }
 }
 
-sub apr { print @_; }
-
 1;
-
-__END__
-
-=head1 NAME
-
-B::Bytecode - Perl compiler's bytecode backend
-
-=head1 SYNOPSIS
-
-	perl -MO=Bytecode[,OPTIONS] foo.pl
-
-=head1 DESCRIPTION
-
-This compiler backend takes Perl source and generates a
-platform-independent bytecode encapsulating code to load the
-internal structures perl uses to run your program. When the
-generated bytecode is loaded in, your program is ready to run,
-reducing the time which perl would have taken to load and parse
-your program into its internal semi-compiled form. That means that
-compiling with this backend will not help improve the runtime
-execution speed of your program but may improve the start-up time.
-Depending on the environment in which your program runs this may
-or may not be a help.
-
-The resulting bytecode can be run with a special byteperl executable
-or (for non-main programs) be loaded via the C<byteload_fh> function
-in the F<B> module.
-
-=head1 OPTIONS
-
-If there are any non-option arguments, they are taken to be names of
-objects to be saved (probably doesn't work properly yet).  Without
-extra arguments, it saves the main program.
-
-=over 4
-
-=item B<-ofilename>
-
-Output to filename instead of STDOUT.
-
-=item B<-afilename>
-
-Append output to filename.
-
-=item B<-->
-
-Force end of options.
-
-=item B<-f>
-
-Force optimisations on or off one at a time. Each can be preceded
-by B<no-> to turn the option off (e.g. B<-fno-compress-nullops>).
-
-=item B<-fcompress-nullops>
-
-Only fills in the necessary fields of ops which have
-been optimised away by perl's internal compiler.
-
-=item B<-fomit-sequence-numbers>
-
-Leaves out code to fill in the op_seq field of all ops
-which is only used by perl's internal compiler.
-
-=item B<-fbypass-nullops>
-
-If op->op_next ever points to a NULLOP, replaces the op_next field
-with the first non-NULLOP in the path of execution.
-
-=item B<-On>
-
-Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
-B<-O1> sets B<-fcompress-nullops> B<-fomit-sequence numbers>.
-B<-O2> adds B<-fbypass-nullops>.
-
-=item B<-D>
-
-Debug options (concatenated or separate flags like C<perl -D>).
-
-=item B<-Do>
-
-Prints each OP as it's processed.
-
-=item B<-Db>
-
-Print debugging information about bytecompiler progress.
-
-=item B<-Da>
-
-Tells the (bytecode) assembler to include source assembler lines
-in its output as bytecode comments.
-
-=item B<-DC>
-
-Prints each CV taken from the final symbol tree walk.
-
-=item B<-S>
-
-Output (bytecode) assembler source rather than piping it
-through the assembler and outputting bytecode.
-
-=item B<-upackage>
-
-Stores package in the output.
-
-=back
-
-=head1 EXAMPLES
-
-    perl -MO=Bytecode,-O6,-ofoo.plc,-umain foo.pl
-
-    perl -MO=Bytecode,-S,-umain foo.pl > foo.S
-    assemble foo.S > foo.plc
-
-Note that C<assemble> lives in the C<B> subdirectory of your perl
-library directory. The utility called perlcc may also be used to 
-help make use of this compiler.
-
-    perl -MO=Bytecode,-uFoo,-oFoo.pmc Foo.pm
-
-=head1 BUGS
-
-Output is still huge and there are still occasional crashes during
-either compilation or ByteLoading. Current status: experimental.
-
-=head1 AUTHORS
-
-Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
-Benjamin Stuhl, C<sho_pi@hotmail.com>
-
-=cut
diff --git a/ext/B/B/Disassembler.pm b/ext/B/B/Disassembler.pm
index a50b48f741..a563715371 100644
--- a/ext/B/B/Disassembler.pm
+++ b/ext/B/B/Disassembler.pm
@@ -137,7 +137,8 @@ sub GET_none {}
 
 sub GET_op_tr_array {
     my $fh = shift;
-    my @ary = unpack("S256", $fh->readn(256 * 2));
+    my $len = unpack "S", $fh->readn(2);
+    my @ary = unpack "S*", $fh->readn($len*2);
     return join(",", @ary);
 }
 
diff --git a/ext/B/typemap b/ext/B/typemap
index 77a92ea7e8..99aec73a3d 100644
--- a/ext/B/typemap
+++ b/ext/B/typemap
@@ -25,6 +25,7 @@ B::CV		T_SV_OBJ
 B::HV		T_SV_OBJ
 B::AV		T_SV_OBJ
 B::IO		T_SV_OBJ
+B::FM		T_SV_OBJ
 
 B::MAGIC	T_MG_OBJ
 SSize_t		T_IV
diff --git a/ext/ByteLoader/ByteLoader.pm b/ext/ByteLoader/ByteLoader.pm
index 9c8c84d677..08a53a658e 100644
--- a/ext/ByteLoader/ByteLoader.pm
+++ b/ext/ByteLoader/ByteLoader.pm
@@ -2,15 +2,12 @@ package ByteLoader;
 
 use XSLoader ();
 
-$VERSION = 0.04;
+our $VERSION = '0.04';
 
 XSLoader::load 'ByteLoader', $VERSION;
 
-# Preloaded methods go here.
-
 1;
 __END__
-
 =head1 NAME
 
 ByteLoader - load byte compiled perl code
@@ -20,18 +17,20 @@ ByteLoader - load byte compiled perl code
   use ByteLoader 0.04;
   <byte code>
 
-  use ByteLoader 0.04;
-  <byte code>
+  or just
+
+  perl -MByteLoader bytecode_file
 
 =head1 DESCRIPTION
 
-This module is used to load byte compiled perl code. It uses the source
-filter mechanism to read the byte code and insert it into the compiled
-code at the appropriate point.
+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
 
diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs
index 4588b02ef0..e71b7cdb9b 100644
--- a/ext/ByteLoader/ByteLoader.xs
+++ b/ext/ByteLoader/ByteLoader.xs
@@ -1,4 +1,3 @@
-#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -27,7 +26,7 @@ bl_getc(struct byteloader_fdata *data)
       /* Else there must be at least one byte present, which is good enough */
     }
 
-    return *((char *) SvPV_nolen (data->datasv) + data->next_out++);
+    return *((U8 *) SvPV_nolen (data->datasv) + data->next_out++);
 }
 
 int
@@ -81,6 +80,7 @@ byteloader_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     OP *savestart = PL_main_start;
     struct byteloader_state bstate;
     struct byteloader_fdata data;
+    int len;
 
     data.next_out = 0;
     data.datasv = FILTER_DATA(idx);
@@ -92,7 +92,14 @@ byteloader_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     bstate.bs_sv = Nullsv;
     bstate.bs_iv_overflows = 0;
 
-    byterun(aTHX_ &bstate);
+/* 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;
@@ -125,9 +132,3 @@ import(package="ByteLoader", ...)
     if (!sv)
       croak ("Could not allocate ByteLoader buffers");
     filter_add(byteloader_filter, sv);
-
-void
-unimport(package="ByteLoader", ...)
-  char *package
-  PPCODE:
-    filter_del(byteloader_filter);
diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index 1c94b66246..4602a68dc5 100644
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -6,25 +6,29 @@ typedef int comment_t;
 typedef SV *svindex;
 typedef OP *opindex;
 typedef char *pvindex;
-typedef IV IV64;
 
 #define BGET_FREAD(argp, len, nelem)	\
 	 bl_read(bstate->bs_fdata,(char*)(argp),(len),(nelem))
 #define BGET_FGETC() bl_getc(bstate->bs_fdata)
 
-#define BGET_U32(arg)	\
-	BGET_FREAD(&arg, sizeof(U32), 1)
-#define BGET_I32(arg)	\
-	BGET_FREAD(&arg, sizeof(I32), 1)
+/* all this should be made endianness-agnostic */
+
+#define BGET_U8(arg)	arg = BGET_FGETC()
 #define BGET_U16(arg)	\
 	BGET_FREAD(&arg, sizeof(U16), 1)
-#define BGET_U8(arg)	arg = BGET_FGETC()
+#define BGET_U32(arg)	\
+	BGET_FREAD(&arg, sizeof(U32), 1)
+#define BGET_UV(arg)	\
+	BGET_FREAD(&arg, sizeof(UV), 1)
+
+#define BGET_I32(arg)	BGET_U32(arg)
+#define BGET_IV(arg)	BGET_UV(arg)
 
 #define BGET_PV(arg)	STMT_START {					\
 	BGET_U32(arg);							\
 	if (arg) {							\
 	    New(666, bstate->bs_pv.xpv_pv, arg, char);			\
-	    bl_read(bstate->bs_fdata, (void*)bstate->bs_pv.xpv_pv, arg, 1);	\
+	    bl_read(bstate->bs_fdata, (void*)bstate->bs_pv.xpv_pv, arg, 1);\
 	    bstate->bs_pv.xpv_len = arg;				\
 	    bstate->bs_pv.xpv_cur = arg - 1;				\
 	} else {							\
@@ -51,39 +55,12 @@ typedef IV IV64;
 	do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF)
 #endif
 
-/*
- * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV
- * machines such that 32-bit machine compilers don't whine about the shift
- * count being too high even though the code is never reached there.
- */
-#define BGET_IV64(arg) STMT_START {			\
-	U32 hi, lo;					\
-	BGET_U32(hi);					\
-	BGET_U32(lo);					\
-	if (sizeof(IV) == 8)				\
-	    arg = ((IV)hi << (sizeof(IV)*4) | (IV)lo);	\
-	else if (((I32)hi == -1 && (I32)lo < 0)		\
-		 || ((I32)hi == 0 && (I32)lo >= 0)) {	\
-	    arg = (I32)lo;				\
-	}						\
-	else {						\
-	    bstate->bs_iv_overflows++;			\
-	    arg = 0;					\
-	}						\
-    } STMT_END
-
-#if IVSIZE == 4
-#   define BGET_IV(arg) BGET_I32(arg)
-#else
-#   if IVSIZE == 8
-#       define BGET_IV(arg) BGET_IV64(arg)
-#   endif
-#endif
 
 #define BGET_op_tr_array(arg) do {			\
-	unsigned short *ary;				\
-	New(666, ary, 256, unsigned short);		\
-	BGET_FREAD(ary, sizeof(unsigned short), 256);	\
+	unsigned short *ary, len;			\
+	BGET_U16(len);					\
+	New(666, ary, len, unsigned short);		\
+	BGET_FREAD(ary, sizeof(unsigned short), len);	\
 	arg = (char *) ary;				\
     } while (0)
 
@@ -126,7 +103,10 @@ typedef IV IV64;
 #define BSET_gv_fetchpv(sv, arg)	sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV)
 #define BSET_gv_stashpv(sv, arg)	sv = (SV*)gv_stashpv(arg, TRUE)
 #define BSET_sv_magic(sv, arg)		sv_magic(sv, Nullsv, arg, 0, 0)
-#define BSET_mg_pv(mg, arg)	mg->mg_ptr = arg; mg->mg_len = bstate->bs_pv.xpv_cur
+#define BSET_mg_name(mg, arg)	mg->mg_ptr = arg; mg->mg_len = bstate->bs_pv.xpv_cur
+#define BSET_mg_namex(mg, arg)			\
+	(mg->mg_ptr = (char*)SvREFCNT_inc((SV*)arg),	\
+	 mg->mg_len = HEf_SVKEY)
 #define BSET_sv_upgrade(sv, arg)	(void)SvUPGRADE(sv, arg)
 #define BSET_xpv(sv)	do {	\
 	SvPV_set(sv, bstate->bs_pv.xpv_pv);	\
@@ -136,14 +116,45 @@ typedef IV IV64;
 #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.xpv_pv, bstate->bs_pv.xpv_cur, arg, 0)
 #define BSET_pv_free(pv)	Safefree(pv.xpv_pv)
+
+
+#ifdef USE_ITHREADS
+
+/* copied after the code in newPMOP() */
 #define BSET_pregcomp(o, arg) \
-	STMT_START { \
-		PM_SETRE(((PMOP*)o), (arg ? \
-        	         CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv_cur, ((PMOP*)o)) : 0)); \
-	} STMT_END
+    STMT_START { \
+        SV* repointer; \
+	REGEXP* rx = arg ? \
+	    CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.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_cur, cPMOPx(o)): \
+	     Null(REGEXP*))); \
+    } STMT_END
+
+#endif /* USE_THREADS */
+
+
 #define BSET_newsv(sv, arg)				\
 	STMT_START {					\
 	    sv = (arg == SVt_PVAV ? (SV*)newAV() :	\
@@ -151,17 +162,70 @@ typedef IV IV64;
 		  NEWSV(666,0));			\
 	    SvUPGRADE(sv, arg);				\
 	} STMT_END
-#define BSET_newop(o, arg)	((o = (OP*)safemalloc(optype_size[arg])), \
-				 memzero((char*)o,optype_size[arg]))
+#define BSET_newop(o, arg)				\
+	((o = (OP*)safemalloc(arg)), memzero((char*)o,arg))
 #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;						\
+#define BSET_ret(foo) STMT_START {		\
+	Safefree(bstate->bs_obj_list);		\
+	return 0;				\
+    } STMT_END
+
+/* 
+ * 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
 
 /*
@@ -179,40 +243,54 @@ typedef IV IV64;
 	PL_comppad = (AV *)arg;			\
 	pad = AvARRAY(arg);			\
     } STMT_END
-/* this works now that Sarathy's changed the CopFILE_set macro to do the SvREFCNT_inc()
-	-- BKS 6-2-2000 */
+
+#ifdef USE_ITHREADS
 #define BSET_cop_file(cop, arg)		CopFILE_set(cop,arg)
-#define BSET_cop_line(cop, arg)		CopLINE_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, cv);			\
-	    call_list(oldscope, PL_beginav);		\
-	    PL_curcop = &PL_compiling;			\
-	    PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);\
-	    LEAVE;					\
+            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;			\
+            PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);\
+            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);							\
+#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);							\
+#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)
+	bset_obj_store(aTHX_ bstate, obj, (I32)ix) : \
+	(bstate->bs_obj_list[ix] = obj)
+
+#define BSET_signal(cv, name)						\
+	mg_set(*hv_store(GvHV(gv_fetchpv("SIG", TRUE, SVt_PVHV)),	\
+		name, strlen(name), cv, 0))
 
 /* 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
diff --git a/installperl b/installperl
index 52df9c18b9..67d4530ab2 100755
--- a/installperl
+++ b/installperl
@@ -756,7 +756,7 @@ sub installlib {
 
     # ignore patch backups, RCS files, emacs backup & temp files and the
     # .exists files, .PL files, and test files.
-    return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.t$|^test\.pl$} ||
+    return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.plc$|\.t$|^test\.pl$} ||
 	      $dir  =~ m{/t(?:/|$)};
     # ignore the cpan script in lib/CPAN/bin (installed later with other utils)
     return if $name eq 'cpan';
diff --git a/t/TEST b/t/TEST
index 92a9d8fd0e..014fa124c3 100755
--- a/t/TEST
+++ b/t/TEST
@@ -21,7 +21,7 @@ if ($#ARGV >= 0) {
 	$verbose = 1 if $1 eq 'v';
 	$torture = 1 if $1 eq 'torture';
 	$with_utf= 1 if $1 eq 'utf8';
-        $byte_compile = 1 if $1 eq 'bytecompile';
+        $bytecompile = 1 if $1 eq 'bytecompile';
         $compile = 1 if $1 eq 'compile';
 	if ($1 =~ /^deparse(,.+)?$/) {
 	    $deparse = 1;
@@ -125,9 +125,11 @@ unless (@ARGV) {
 if ($deparse) {
     _testprogs('deparse', '',   @ARGV);
 }
-elsif( $compile || $byte_compile ) { 
-    _testprogs('compile', '',   @ARGV) if $compile;
-    _testprogs('compile', '-B', @ARGV) if $byte_compile;
+elsif( $compile ) { 
+    _testprogs('compile', '',   @ARGV);
+}
+elsif( $bytecompile ) {
+    _testprogs('bytecompile', '', @ARGV);
 }
 else {
     _testprogs('compile', '',   @ARGV) if -e "../testcompile";
@@ -151,6 +153,12 @@ TESTING DEPARSER
 ------------------------------------------------------------------------------
 EOT
 
+    print <<'EOT' if ($type eq 'bytecompile');
+------------------------------------------------------------------------------
+TESTING BYTECODE COMPILER
+------------------------------------------------------------------------------
+EOT
+
     $ENV{PERLCC_TIMEOUT} = 120
           if ($type eq 'compile' && !$ENV{PERLCC_TIMEOUT});
 
@@ -235,6 +243,25 @@ EOT
 	    open(RESULTS, $deparse)
 		or print "can't deparse '$deparse': $!.\n";
 	}
+	elsif ($type eq 'bytecompile') {
+	    my $perl = $ENV{PERL} || './perl';
+	    my $redir = ($^O eq 'VMS' ? '2>&1' : '');
+	    my $bswitch = "-MO=Bytecode,-H,-s,-TD`pwd`,";
+	    $bswitch .= "-TF,"
+		if $test =~ m(chdir|pod/|CGI/t/carp|lib/DB);
+	    $bswitch .= "-k,"
+		if $test =~ m(deparse|terse|ext/Storable/t/code);
+	    $bswitch .= "-k,"
+		if $] < 5.009 && $test =~ m(avhv|hashwarn);
+	    $bswitch .= "-b,"
+		if $test =~ m(op/getpid);
+	    my $bytecompile =
+		"$perl $testswitch $switch -I../lib $bswitch". 
+		"-o$test.plc $test 2>/dev/null &&".
+		"$perl $testswitch $switch $utf $test.plc $redir|";
+	    open(RESULTS,$bytecompile)
+		or print "can't byte-compile '$bytecompile': $!.\n";
+	}
 	elsif ($type eq 'perl') {
 	    my $perl = $ENV{PERL} || './perl';
 	    my $redir = ($^O eq 'VMS' ? '2>&1' : '');
diff --git a/utils/perlcc.PL b/utils/perlcc.PL
index 15a276a3cb..313a972d88 100644
--- a/utils/perlcc.PL
+++ b/utils/perlcc.PL
@@ -225,53 +225,18 @@ sub compile_module {
 }
 
 sub compile_byte {
-    require ByteLoader;
-    my $stash = grab_stash();
-    my $command = "$BinPerl -MO=Bytecode,$stash $Input";
-    # The -a option means we'd have to close the file and lose the
-    # lock, which would create the tiniest of races. Instead, append
-    # the output ourselves. 
-    vprint 1, "Writing on $Output";
-
-    my $openflags = O_WRONLY | O_CREAT;
-    $openflags |= O_BINARY if eval { O_BINARY; 1 };
-    $openflags |= O_EXLOCK if eval { O_EXLOCK; 1 };
-
-    # these dies are not "$0: .... \n" because they "can't happen"
-
-    sysopen(OUT, $Output, $openflags)
-        or die "can't write to $Output: $!";
-
-    # this is blocking; hold on; why are we doing this??
-    # flock OUT, LOCK_EX or die "can't lock $Output: $!"
-    #    unless eval { O_EXLOCK; 1 };
-
-    truncate(OUT, 0)
-        or die "couldn't trunc $Output: $!";
-
-    print OUT <<EOF;
-#!$^X
-use ByteLoader $ByteLoader::VERSION;
-EOF
-
-    # Now the compile:
-    vprint 1, "Compiling...";
-    vprint 3, "Calling $command";
+    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, which can't happen:\n@$error_r\n");
+	_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;
     }
 
-    # Write it and leave.
-    print OUT @$output_r               or _die("can't write $Output: $!");
-    close OUT                          or _die("can't close $Output: $!");
-
-    # wait, how could it be anything but what you see next?
     chmod 0777 & ~umask, $Output    or _die("can't chmod $Output: $!");
     exit 0;
 }