From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Thu, 22 Jun 2000 16:06:34 +0000 (+0000)
Subject: Bytecode patches from Benjamin Stuhl.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f8519be6fd9bf0423897a621d943e29ddc834d84;p=p5sagit%2Fp5-mst-13.2.git

Bytecode patches from Benjamin Stuhl.

p4raw-id: //depot/cfgperl@6219
---

diff --git a/bytecode.pl b/bytecode.pl
index f847298..9321604 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -92,39 +92,29 @@ printf BYTERUN_C "    sizeof(%s)\n", $optype[$i], $i;
 print BYTERUN_C <<'EOT';
 };
 
-static int bytecode_iv_overflows = 0;
-static void **bytecode_obj_list = Null(void**);
-static I32 bytecode_obj_list_fill = -1;
-
 void *
-bset_obj_store(pTHXo_ void *obj, I32 ix)
+bset_obj_store(pTHXo_ struct byteloader_state *bstate, void *obj, I32 ix)
 {
-    if (ix > bytecode_obj_list_fill) {
-	if (bytecode_obj_list_fill == -1)
-	    New(666, bytecode_obj_list, ix + 32, void*);
-	else
-	    Renew(bytecode_obj_list, ix + 32, void*);
-	bytecode_obj_list_fill = ix;
+    if (ix > bstate->bs_obj_list_fill) {
+	Renew(bstate->bs_obj_list, ix + 32, void*);
+	bstate->bs_obj_list_fill = ix + 31;
     }
-    bytecode_obj_list[ix] = obj;
+    bstate->bs_obj_list[ix] = obj;
     return obj;
 }
 
 void
-byterun(pTHXo)
+byterun(pTHXo_ register struct byteloader_state *bstate)
 {
     dTHR;
-    int insn;
-    SV *bytecode_sv;
-    XPV bytecode_pv;
+    register int insn;
+    U32 ix;
     SV *specialsv_list[6];
-    ENTER;
-    SAVEVPTR(bytecode_obj_list);
-    SAVEI32(bytecode_obj_list_fill);
-    bytecode_obj_list = Null(void**);
-    bytecode_obj_list_fill = -1;
 
     BYTECODE_HEADER_CHECK;	/* croak if incorrect platform */
+    New(666, bstate->bs_obj_list, 32, void*); /* set op objlist */
+    bstate->bs_obj_list_fill = 31;
+
 EOT
 
 for (my $i = 0; $i < @specialsv; $i++) {
@@ -203,13 +193,25 @@ EOT
 #
 open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!";
 print BYTERUN_H $c_header, <<'EOT';
-struct bytestream { /* XXX: not currently used - too slow */
-    void *data;
-    int (*pfgetc)(void *);
-    int (*pfread)(char *, size_t, size_t, void *);
-    void (*pfreadpv)(U32, void *, XPV *);
+struct byteloader_fdata {
+    SV	*datasv;
+    int next_out;
+    int	idx;
+};
+
+struct byteloader_state {
+    struct byteloader_fdata	*bs_fdata;
+    SV				*bs_sv;
+    void			**bs_obj_list;
+    int				bs_obj_list_fill;
+    XPV				bs_pv;
+    int				bs_iv_overflows;
 };
 
+int bl_getc(struct byteloader_fdata *);
+int bl_read(struct byteloader_fdata *, char *, size_t, size_t);
+extern void byterun(pTHXo_ struct byteloader_state *);
+
 enum {
 EOT
 
@@ -238,10 +240,6 @@ for ($i = 0; $i < @optype - 1; $i++) {
 }
 printf BYTERUN_H "    OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i;
 
-print BYTERUN_H <<'EOT';
-extern void byterun(pTHXo);
-EOT
-
 #
 # Finish off insn_data and create array initialisers in Asmdata.pm
 #
@@ -291,85 +289,86 @@ nop		none			none
 #opcode		lvalue					argtype		flags	
 #
 ret		none					none		x
-ldsv		bytecode_sv				svindex
+ldsv		bstate->bs_sv				svindex
 ldop		PL_op					opindex
-stsv		bytecode_sv				U32		s
+stsv		bstate->bs_sv				U32		s
 stop		PL_op					U32		s
-ldspecsv	bytecode_sv				U8		x
-newsv		bytecode_sv				U8		x
+stpv		bstate->bs_pv.xpv_pv			U32		x
+ldspecsv	bstate->bs_sv				U8		x
+newsv		bstate->bs_sv				U8		x
 newop		PL_op					U8		x
 newopn		PL_op					U8		x
 newpv		none					PV
-pv_cur		bytecode_pv.xpv_cur			STRLEN
-pv_free		bytecode_pv				none		x
-sv_upgrade	bytecode_sv				char		x
-sv_refcnt	SvREFCNT(bytecode_sv)			U32
-sv_refcnt_add	SvREFCNT(bytecode_sv)			I32		x
-sv_flags	SvFLAGS(bytecode_sv)			U32
-xrv		SvRV(bytecode_sv)			svindex
-xpv		bytecode_sv				none		x
-xiv32		SvIVX(bytecode_sv)			I32
-xiv64		SvIVX(bytecode_sv)			IV64
-xnv		SvNVX(bytecode_sv)			NV
-xlv_targoff	LvTARGOFF(bytecode_sv)			STRLEN
-xlv_targlen	LvTARGLEN(bytecode_sv)			STRLEN
-xlv_targ	LvTARG(bytecode_sv)			svindex
-xlv_type	LvTYPE(bytecode_sv)			char
-xbm_useful	BmUSEFUL(bytecode_sv)			I32
-xbm_previous	BmPREVIOUS(bytecode_sv)			U16
-xbm_rare	BmRARE(bytecode_sv)			U8
-xfm_lines	FmLINES(bytecode_sv)			I32
-xio_lines	IoLINES(bytecode_sv)			long
-xio_page	IoPAGE(bytecode_sv)			long
-xio_page_len	IoPAGE_LEN(bytecode_sv)			long
-xio_lines_left	IoLINES_LEFT(bytecode_sv)	       	long
-xio_top_name	IoTOP_NAME(bytecode_sv)			pvcontents
-xio_top_gv	*(SV**)&IoTOP_GV(bytecode_sv)		svindex
-xio_fmt_name	IoFMT_NAME(bytecode_sv)			pvcontents
-xio_fmt_gv	*(SV**)&IoFMT_GV(bytecode_sv)		svindex
-xio_bottom_name	IoBOTTOM_NAME(bytecode_sv)		pvcontents
-xio_bottom_gv	*(SV**)&IoBOTTOM_GV(bytecode_sv)	svindex
-xio_subprocess	IoSUBPROCESS(bytecode_sv)		short
-xio_type	IoTYPE(bytecode_sv)			char
-xio_flags	IoFLAGS(bytecode_sv)			char
-xcv_stash	*(SV**)&CvSTASH(bytecode_sv)		svindex
-xcv_start	CvSTART(bytecode_sv)			opindex
-xcv_root	CvROOT(bytecode_sv)			opindex
-xcv_gv		*(SV**)&CvGV(bytecode_sv)		svindex
-xcv_file	CvFILE(bytecode_sv)			pvcontents
-xcv_depth	CvDEPTH(bytecode_sv)			long
-xcv_padlist	*(SV**)&CvPADLIST(bytecode_sv)		svindex
-xcv_outside	*(SV**)&CvOUTSIDE(bytecode_sv)		svindex
-xcv_flags	CvFLAGS(bytecode_sv)			U16
-av_extend	bytecode_sv				SSize_t		x
-av_push		bytecode_sv				svindex		x
-xav_fill	AvFILLp(bytecode_sv)			SSize_t
-xav_max		AvMAX(bytecode_sv)			SSize_t
-xav_flags	AvFLAGS(bytecode_sv)			U8
-xhv_riter	HvRITER(bytecode_sv)			I32
-xhv_name	HvNAME(bytecode_sv)			pvcontents
-hv_store	bytecode_sv				svindex		x
-sv_magic	bytecode_sv				char		x
-mg_obj		SvMAGIC(bytecode_sv)->mg_obj		svindex
-mg_private	SvMAGIC(bytecode_sv)->mg_private	U16
-mg_flags	SvMAGIC(bytecode_sv)->mg_flags		U8
-mg_pv		SvMAGIC(bytecode_sv)			pvcontents	x
-xmg_stash	*(SV**)&SvSTASH(bytecode_sv)		svindex
-gv_fetchpv	bytecode_sv				strconst	x
-gv_stashpv	bytecode_sv				strconst	x
-gp_sv		GvSV(bytecode_sv)			svindex
-gp_refcnt	GvREFCNT(bytecode_sv)			U32
-gp_refcnt_add	GvREFCNT(bytecode_sv)			I32		x
-gp_av		*(SV**)&GvAV(bytecode_sv)		svindex
-gp_hv		*(SV**)&GvHV(bytecode_sv)		svindex
-gp_cv		*(SV**)&GvCV(bytecode_sv)		svindex
-gp_file		GvFILE(bytecode_sv)			pvcontents
-gp_io		*(SV**)&GvIOp(bytecode_sv)		svindex
-gp_form		*(SV**)&GvFORM(bytecode_sv)		svindex
-gp_cvgen	GvCVGEN(bytecode_sv)			U32
-gp_line		GvLINE(bytecode_sv)			line_t
-gp_share	bytecode_sv				svindex		x
-xgv_flags	GvFLAGS(bytecode_sv)			U8
+pv_cur		bstate->bs_pv.xpv_cur			STRLEN
+pv_free		bstate->bs_pv				none		x
+sv_upgrade	bstate->bs_sv				char		x
+sv_refcnt	SvREFCNT(bstate->bs_sv)			U32
+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
+xnv		SvNVX(bstate->bs_sv)			NV
+xlv_targoff	LvTARGOFF(bstate->bs_sv)		STRLEN
+xlv_targlen	LvTARGLEN(bstate->bs_sv)		STRLEN
+xlv_targ	LvTARG(bstate->bs_sv)			svindex
+xlv_type	LvTYPE(bstate->bs_sv)			char
+xbm_useful	BmUSEFUL(bstate->bs_sv)			I32
+xbm_previous	BmPREVIOUS(bstate->bs_sv)		U16
+xbm_rare	BmRARE(bstate->bs_sv)			U8
+xfm_lines	FmLINES(bstate->bs_sv)			I32
+xio_lines	IoLINES(bstate->bs_sv)			long
+xio_page	IoPAGE(bstate->bs_sv)			long
+xio_page_len	IoPAGE_LEN(bstate->bs_sv)		long
+xio_lines_left	IoLINES_LEFT(bstate->bs_sv)	       	long
+xio_top_name	IoTOP_NAME(bstate->bs_sv)		pvcontents
+xio_top_gv	*(SV**)&IoTOP_GV(bstate->bs_sv)		svindex
+xio_fmt_name	IoFMT_NAME(bstate->bs_sv)		pvcontents
+xio_fmt_gv	*(SV**)&IoFMT_GV(bstate->bs_sv)		svindex
+xio_bottom_name	IoBOTTOM_NAME(bstate->bs_sv)		pvcontents
+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_stash	*(SV**)&CvSTASH(bstate->bs_sv)		svindex
+xcv_start	CvSTART(bstate->bs_sv)			opindex
+xcv_root	CvROOT(bstate->bs_sv)			opindex
+xcv_gv		*(SV**)&CvGV(bstate->bs_sv)		svindex
+xcv_file	CvFILE(bstate->bs_sv)			pvindex
+xcv_depth	CvDEPTH(bstate->bs_sv)			long
+xcv_padlist	*(SV**)&CvPADLIST(bstate->bs_sv)	svindex
+xcv_outside	*(SV**)&CvOUTSIDE(bstate->bs_sv)	svindex
+xcv_flags	CvFLAGS(bstate->bs_sv)			U16
+av_extend	bstate->bs_sv				SSize_t		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
+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
+xmg_stash	*(SV**)&SvSTASH(bstate->bs_sv)		svindex
+gv_fetchpv	bstate->bs_sv				strconst	x
+gv_stashpv	bstate->bs_sv				strconst	x
+gp_sv		GvSV(bstate->bs_sv)			svindex
+gp_refcnt	GvREFCNT(bstate->bs_sv)			U32
+gp_refcnt_add	GvREFCNT(bstate->bs_sv)			I32		x
+gp_av		*(SV**)&GvAV(bstate->bs_sv)		svindex
+gp_hv		*(SV**)&GvHV(bstate->bs_sv)		svindex
+gp_cv		*(SV**)&GvCV(bstate->bs_sv)		svindex
+gp_file		GvFILE(bstate->bs_sv)			pvindex
+gp_io		*(SV**)&GvIOp(bstate->bs_sv)		svindex
+gp_form		*(SV**)&GvFORM(bstate->bs_sv)		svindex
+gp_cvgen	GvCVGEN(bstate->bs_sv)			U32
+gp_line		GvLINE(bstate->bs_sv)			line_t
+gp_share	bstate->bs_sv				svindex		x
+xgv_flags	GvFLAGS(bstate->bs_sv)			U8
 op_next		PL_op->op_next				opindex
 op_sibling	PL_op->op_sibling			opindex
 op_ppaddr	PL_op->op_ppaddr			strconst	x
@@ -396,9 +395,9 @@ op_pv_tr	cPVOP->op_pv				op_tr_array
 op_redoop	cLOOP->op_redoop			opindex
 op_nextop	cLOOP->op_nextop			opindex
 op_lastop	cLOOP->op_lastop			opindex
-cop_label	cCOP->cop_label				pvcontents
-cop_stashpv	cCOP					pvcontents	x
-cop_file	cCOP					pvcontents	x
+cop_label	cCOP->cop_label				pvindex
+cop_stashpv	cCOP					pvindex		x
+cop_file	cCOP					pvindex		x
 cop_seq		cCOP->cop_seq				U32
 cop_arybase	cCOP->cop_arybase			I32
 cop_line	cCOP					line_t		x
diff --git a/ext/B/B/Assembler.pm b/ext/B/B/Assembler.pm
index 06e7c1a..5e798ce 100644
--- a/ext/B/B/Assembler.pm
+++ b/ext/B/B/Assembler.pm
@@ -4,15 +4,17 @@
 #
 #      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 $VERSIOM
 
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(assemble_fh assemble_insn strip_comments
-		parse_statement uncstring gen_header);
+@EXPORT_OK = qw(assemble_fh newasm endasm assemble);
+$VERSION = 0.02;
 
 use strict;
 my %opnumber;
@@ -21,7 +23,7 @@ for ($i = 0; defined($opname = ppname($i)); $i++) {
     $opnumber{$opname} = $i;
 }
 
-my ($linenum, $errors);
+my($linenum, $errors, $out); #	global state, set up by newasm
 
 sub error {
     my $str = shift;
@@ -58,6 +60,7 @@ sub B::Asmdata::PUT_NV  { sprintf("%s\0", $_[0]) } # "%lf" looses precision and
 sub B::Asmdata::PUT_objindex { pack("L", $_[0]) } # could allow names here
 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;
@@ -140,16 +143,20 @@ sub strip_comments {
     return $stmt;
 }
 
-sub gen_header {	# create the ByteCode header: magic, archname, ivsize, ptrsize, 
-			# byteorder
-			# nvtype irrelevant (floats are stored as strings)
-    my $header = B::Asmdata::PUT_U32(0x43424c50);	# 'PLBC'
-    $header .= B::Asmdata::PUT_strconst(qq["$Config{archname}"]);
+# 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 .= B::Asmdata::PUT_strconst(sprintf(qq["0x%s"], $Config{byteorder}));
-							# PV not U32 because 
-							# of varying size
 
     $header;
 }
@@ -199,28 +206,52 @@ sub assemble_insn {
 
 sub assemble_fh {
     my ($fh, $out) = @_;
-    my ($line, $insn, $arg);
-    $linenum = 0;
-    $errors = 0;
-    &$out(gen_header());
+    my $line;
+    my $asm = newasm($out);
     while ($line = <$fh>) {
-	$linenum++;
-	chomp $line;
-	if ($debug) {
-	    my $quotedline = $line;
-	    $quotedline =~ s/\\/\\\\/g;
-	    $quotedline =~ s/"/\\"/g;
-	    &$out(assemble_insn("comment", qq("$quotedline")));
-	}
-	$line = strip_comments($line) or next;
-	($insn, $arg) = parse_statement($line);
-	&$out(assemble_insn($insn, $arg));
-	if ($debug) {
-	    &$out(assemble_insn("nop", undef));
-	}
+	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 "Assembly failed with $errors error(s)\n";
+	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")));
+    }
+    $line = strip_comments($line) or next;
+    ($insn, $arg) = parse_statement($line);
+    $out->(assemble_insn($insn, $arg));
+    if ($debug) {
+	$out->(assemble_insn("nop", undef));
     }
 }
 
@@ -234,14 +265,21 @@ B::Assembler - Assemble Perl bytecode
 
 =head1 SYNOPSIS
 
-	use Assembler;
+	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 AUTHOR
+=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/Bytecode.pm b/ext/B/B/Bytecode.pm
index 4b2197e..ef59c4a 100644
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -6,18 +6,18 @@
 #      License or the Artistic License, as specified in the README file.
 #
 package B::Bytecode;
-use strict;
-use IO::File;
 
+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
+	 GVf_IMPORTED_SV SVTYPEMASK
 	);
 use B::Asmdata qw(@optype @specialsv_name);
-use B::Assembler qw(assemble_fh);
+use B::Assembler qw(newasm endasm assemble);
 
 my %optype_enum;
 my $i;
@@ -36,45 +36,73 @@ 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, $module_only, $no_assemble, $debug_bc, $debug_cv);
-my $assembler_pid;
 
+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);
+    }
+}
+
+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);
+    }
+}
+
 # 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 ($strip_syntree, $compress_nullops, $omit_seq, $bypass_nullops);
-my %optimise = (strip_syntax_tree	=> \$strip_syntree,
-		compress_nullops	=> \$compress_nullops,
+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) {
-	print "ldsv $ix\n";
+	asm "ldsv $ix\n";
 	$svix = $ix;
     }
 }
 
 sub stsv {
     my $ix = shift;
-    print "stsv $ix\n";
+    asm "stsv $ix\n";
     $svix = $ix;
 }
 
@@ -85,14 +113,14 @@ sub set_svix {
 sub ldop {
     my $ix = shift;
     if ($ix != $opix) {
-	print "ldop $ix\n";
+	asm "ldop $ix\n";
 	$opix = $ix;
     }
 }
 
 sub stop {
     my $ix = shift;
-    print "stop $ix\n";
+    asm "stop $ix\n";
     $opix = $ix;
 }
 
@@ -112,14 +140,26 @@ sub pvstring {
 sub nv {
     # print full precision
     my $str = sprintf "%.40f", $_[0];
+    $str =~ s/0+$//;		# remove trailing zeros
+    $str =~ s/\.$/.0/;
     return $str;
 }
+
 sub saved { $saved{${$_[0]}} }
 sub mark_saved { $saved{${$_[0]}} = 1 }
 sub unmark_saved { $saved{${$_[0]}} = 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::OBJECT::nyi {
     my $obj = shift;
     warn sprintf("bytecode save method for %s (0x%x) not yet implemented\n",
@@ -143,7 +183,7 @@ sub B::OBJECT::objix {
 
 sub B::SV::newix {
     my ($sv, $ix) = @_;
-    printf "newsv %d\t# %s\n", $sv->FLAGS & 0xf, class($sv);
+    asmf "newsv %d\t# %s\n", $sv->FLAGS & SVTYPEMASK, class($sv);
     stsv($ix);    
 }
 
@@ -151,7 +191,7 @@ sub B::GV::newix {
     my ($gv, $ix) = @_;
     my $gvname = $gv->NAME;
     my $name = cstring($gv->STASH->NAME . "::" . $gvname);
-    print "gv_fetchpv $name\n";
+    asm "gv_fetchpv $name\n";
     stsv($ix);
 }
 
@@ -160,7 +200,7 @@ sub B::HV::newix {
     my $name = $hv->NAME;
     if ($name) {
 	# It's a stash
-	printf "gv_stashpv %s\n", cstring($name);
+	asmf "gv_stashpv %s\n", cstring($name);
 	stsv($ix);
     } else {
 	# It's an ordinary HV. Fall back to ordinary newix method
@@ -172,7 +212,7 @@ sub B::SPECIAL::newix {
     my ($sv, $ix) = @_;
     # Special case. $$sv is not the address of the SV but an
     # index into svspecialsv_list.
-    printf "ldspecsv $$sv\t# %s\n", $specialsv_name[$$sv];
+    asmf "ldspecsv $$sv\t# %s\n", $specialsv_name[$$sv];
     stsv($ix);
 }
 
@@ -180,9 +220,8 @@ sub B::OP::newix {
     my ($op, $ix) = @_;
     my $class = class($op);
     my $typenum = $optype_enum{$class};
-    require('Carp.pm'), Carp::croak("OP::newix: can't understand class $class")
-	 unless defined($typenum);
-    print "newop $typenum\t# $class\n";
+    croak("OP::newix: can't understand class $class") unless defined($typenum);
+    asm "newop $typenum\t# $class\n";
     stop($ix);
 }
 
@@ -204,14 +243,14 @@ sub B::OP::bytecode {
     }
     $nextix = $next->objix;
 
-    printf "# %s\n", peekop($op) if $debug_bc;
+    asmf "# %s\n", peekop($op) if $debug_bc;
     ldop($ix);
-    print "op_next $nextix\n";
-    print "op_sibling $sibix\n" unless $strip_syntree;
-    printf "op_type %s\t# %d\n", "pp_" . $op->name, $type;
-    printf("op_seq %d\n", $op->seq) unless $omit_seq;
+    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) {
-	printf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n",
+	asmf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n",
 	    $op->targ, $op->flags, $op->private;
     }
 }
@@ -221,7 +260,7 @@ sub B::UNOP::bytecode {
     my $firstix = $op->first->objix unless $strip_syntree;
     $op->B::OP::bytecode;
     if (($op->type || !$compress_nullops) && !$strip_syntree) {
-	print "op_first $firstix\n";
+	asm "op_first $firstix\n";
     }
 }
 
@@ -229,7 +268,7 @@ sub B::LOGOP::bytecode {
     my $op = shift;
     my $otherix = $op->other->objix;
     $op->B::UNOP::bytecode;
-    print "op_other $otherix\n";
+    asm "op_other $otherix\n";
 }
 
 sub B::SVOP::bytecode {
@@ -237,7 +276,7 @@ sub B::SVOP::bytecode {
     my $sv = $op->sv;
     my $svix = $sv->objix;
     $op->B::OP::bytecode;
-    print "op_sv $svix\n";
+    asm "op_sv $svix\n";
     $sv->bytecode;
 }
 
@@ -245,7 +284,7 @@ sub B::PADOP::bytecode {
     my $op = shift;
     my $padix = $op->padix;
     $op->B::OP::bytecode;
-    print "op_padix $padix\n";
+    asm "op_padix $padix\n";
 }
 
 sub B::PVOP::bytecode {
@@ -258,9 +297,9 @@ sub B::PVOP::bytecode {
     #
     if ($op->name eq "trans") {
 	my @shorts = unpack("s256", $pv); # assembler handles endianness
-	print "op_pv_tr ", join(",", @shorts), "\n";
+	asm "op_pv_tr ", join(",", @shorts), "\n";
     } else {
-	printf "newpv %s\nop_pv\n", pvstring($pv);
+	asmf "newpv %s\nop_pv\n", pvstring($pv);
     }
 }
 
@@ -269,7 +308,7 @@ sub B::BINOP::bytecode {
     my $lastix = $op->last->objix unless $strip_syntree;
     $op->B::UNOP::bytecode;
     if (($op->type || !$compress_nullops) && !$strip_syntree) {
-	print "op_last $lastix\n";
+	asm "op_last $lastix\n";
     }
 }
 
@@ -278,7 +317,7 @@ sub B::LISTOP::bytecode {
     my $children = $op->children unless $strip_syntree;
     $op->B::BINOP::bytecode;
     if (($op->type || !$compress_nullops) && !$strip_syntree) {
-	print "op_children $children\n";
+	asm "op_children $children\n";
     }
 }
 
@@ -288,7 +327,7 @@ sub B::LOOP::bytecode {
     my $nextopix = $op->nextop->objix;
     my $lastopix = $op->lastop->objix;
     $op->B::LISTOP::bytecode;
-    print "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n";
+    asm "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n";
 }
 
 sub B::COP::bytecode {
@@ -296,21 +335,21 @@ sub B::COP::bytecode {
     my $file = $op->file;
     my $line = $op->line;
     if ($debug_bc) { # do this early to aid debugging
-	printf "# line %s:%d\n", $file, $line;
+	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;
-    printf <<"EOT", pvstring($op->label), pvstring($stashpv), $op->cop_seq, pvstring($file), $op->arybase;
-newpv %s
-cop_label
-newpv %s
-cop_stashpv
+    asmf <<"EOT", $labelix, $stashix, $op->cop_seq, $fileix, $op->arybase;
+cop_label %d
+cop_stashpv %d
 cop_seq %d
-newpv %s
-cop_file
+cop_file %d
 cop_arybase %d
 cop_line $line
 cop_warnings $warningsix
@@ -338,13 +377,13 @@ sub B::PMOP::bytecode {
     }
     $op->B::LISTOP::bytecode;
     if ($opname eq "pushre") {
-	printf "op_pmreplrootgv $replrootix\n";
+	asmf "op_pmreplrootgv $replrootix\n";
     } else {
-	print "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n";
+	asm "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n";
     }
     my $re = pvstring($op->precomp);
     # op_pmnext omitted since a perl bug means it's sometime corrupt
-    printf <<"EOT", $op->pmflags, $op->pmpermflags;
+    asmf <<"EOT", $op->pmflags, $op->pmpermflags;
 op_pmflags 0x%x
 op_pmpermflags 0x%x
 newpv $re
@@ -359,7 +398,7 @@ sub B::SV::bytecode {
     my $refcnt = $sv->REFCNT;
     my $flags = sprintf("0x%x", $sv->FLAGS);
     ldsv($ix);
-    print "sv_refcnt $refcnt\nsv_flags $flags\n";
+    asm "sv_refcnt $refcnt\nsv_flags $flags\n";
     mark_saved($sv);
 }
 
@@ -367,7 +406,7 @@ sub B::PV::bytecode {
     my $sv = shift;
     return if saved($sv);
     $sv->B::SV::bytecode;
-    printf("newpv %s\nxpv\n", pvstring($sv->PV)) if $sv->FLAGS & POK;
+    asmf("newpv %s\nxpv\n", pvstring($sv->PV)) if $sv->FLAGS & POK;
 }
 
 sub B::IV::bytecode {
@@ -375,14 +414,14 @@ sub B::IV::bytecode {
     return if saved($sv);
     my $iv = $sv->IVX;
     $sv->B::SV::bytecode;
-    printf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32" if $sv->FLAGS & IOK; # could be PVNV
+    asmf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32" if $sv->FLAGS & IOK; # could be PVNV
 }
 
 sub B::NV::bytecode {
     my $sv = shift;
     return if saved($sv);
     $sv->B::SV::bytecode;
-    printf "xnv %s\n", nv($sv->NVX);
+    asmf "xnv %s\n", nv($sv->NVX);
 }
 
 sub B::RV::bytecode {
@@ -392,7 +431,7 @@ sub B::RV::bytecode {
     my $rvix = $rv->objix;
     $rv->bytecode;
     $sv->B::SV::bytecode;
-    print "xrv $rvix\n";
+    asm "xrv $rvix\n";
 }
 
 sub B::PVIV::bytecode {
@@ -400,7 +439,7 @@ sub B::PVIV::bytecode {
     return if saved($sv);
     my $iv = $sv->IVX;
     $sv->B::PV::bytecode;
-    printf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
+    asmf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
 }
 
 sub B::PVNV::bytecode {
@@ -420,12 +459,12 @@ sub B::PVNV::bytecode {
     } else {
 	my $pv = $sv->PV;
 	$sv->B::IV::bytecode;
-	printf "xnv %s\n", nv($sv->NVX);
+	asmf "xnv %s\n", nv($sv->NVX);
 	if ($flag == 1) {
 	    $pv .= "\0" . $sv->TABLE;
-	    printf "newpv %s\npv_cur %d\nxpv\n", pvstring($pv),length($pv)-257;
+	    asmf "newpv %s\npv_cur %d\nxpv\n", pvstring($pv),length($pv)-257;
 	} else {
-	    printf("newpv %s\nxpv\n", pvstring($pv)) if $sv->FLAGS & POK;
+	    asmf("newpv %s\nxpv\n", pvstring($pv)) if $sv->FLAGS & POK;
 	}
     }
 }
@@ -447,9 +486,9 @@ sub B::PVMG::bytecode {
     #
     @mgobjix = map($_->OBJ->objix, @mgchain);
     $sv->B::PVNV::bytecode($flag);
-    print "xmg_stash $stashix\n";
+    asm "xmg_stash $stashix\n";
     foreach $mg (@mgchain) {
-	printf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n",
+	asmf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n",
 	    cstring($mg->TYPE), shift(@mgobjix), pvstring($mg->PTR);
     }
 }
@@ -458,7 +497,7 @@ sub B::PVLV::bytecode {
     my $sv = shift;
     return if saved($sv);
     $sv->B::PVMG::bytecode;
-    printf <<'EOT', $sv->TARGOFF, $sv->TARGLEN, cstring($sv->TYPE);
+    asmf <<'EOT', $sv->TARGOFF, $sv->TARGLEN, cstring($sv->TYPE);
 xlv_targoff %d
 xlv_targlen %d
 xlv_type %s
@@ -470,37 +509,49 @@ sub B::BM::bytecode {
     return if saved($sv);
     # See PVNV::bytecode for an explanation of what the argument does
     $sv->B::PVMG::bytecode(1);
-    printf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n",
+    asmf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n",
 	$sv->USEFUL, $sv->PREVIOUS, $sv->RARE;
 }
 
+sub empty_gv {	# is a GV empty except for imported stuff?
+    my $gv = shift;
+
+    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;
+}
+
 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);
-    printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS;
+    asmf <<"EOT", $gv->FLAGS, $gv->GvFLAGS;
 sv_flags 0x%x
 xgv_flags 0x%x
 EOT
     my $refcnt = $gv->REFCNT;
-    printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
+    asmf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
     return if $gv->is_empty;
-    printf <<"EOT", $gv->LINE, pvstring($gv->FILE);
+    asmf <<"EOT", $gv->LINE, pvix($gv->FILE);
 gp_line %d
-newpv %s
-gp_file
+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;
-    printf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1;
+    asmf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1;
     if ($gvrefcnt > 1 &&  $ix != $egvix) {
-	print "gp_share $egvix\n";
+	asm "gp_share $egvix\n";
     } else {
 	if ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
 	    my $i;
@@ -514,7 +565,7 @@ EOT
 	    # Reset sv register for $gv
 	    ldsv($ix);
 	    for ($i = 0; $i < @ixes; $i++) {
-		printf "gp_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
+		asmf "gp_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
 	    }
 	    # Now save all the subfields
 	    my $sv;
@@ -544,10 +595,10 @@ sub B::HV::bytecode {
 	}
 	ldsv($ix);
 	for ($i = 0; $i < @contents; $i += 2) {
-	    printf("newpv %s\nhv_store %d\n",
+	    asmf("newpv %s\nhv_store %d\n",
 		   pvstring($contents[$i]), $ixes[$i / 2]);
 	}
-	printf "sv_refcnt %d\nsv_flags 0x%x\n", $hv->REFCNT, $hv->FLAGS;
+	asmf "sv_refcnt %d\nsv_flags 0x%x\n", $hv->REFCNT, $hv->FLAGS;
     }
 }
 
@@ -572,25 +623,26 @@ sub B::AV::bytecode {
     # create an AV with NEWSV and SvUPGRADE rather than doing newAV
     # which is what sets AvMAX and AvFILL.
     ldsv($ix);
-    printf "sv_flags 0x%x\n", $av->FLAGS & ~SVf_READONLY; # SvREADONLY_off($av) in case PADCONST
-    printf "xav_flags 0x%x\nxav_max -1\nxav_fill -1\n", $av->AvFLAGS;
+    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) {
-	    print "av_push $elix\n";
+	    asm "av_push $elix\n";
 	}
     } else {
 	if ($max > -1) {
-	    print "av_extend $max\n";
+	    asm "av_extend $max\n";
 	}
     }
-    printf "sv_flags 0x%x\n", $av->FLAGS; # restore flags from above
+    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;
@@ -605,10 +657,10 @@ sub B::CV::bytecode {
     # Reset sv register for $cv (since above ->objix calls stomped on it)
     ldsv($ix);
     for ($i = 0; $i < @ixes; $i++) {
-	printf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
+	asmf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
     }
-    printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->CvFLAGS;
-    printf "newpv %s\nxcv_file\n", pvstring($cv->FILE);
+    asmf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->CvFLAGS;
+    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
@@ -631,17 +683,17 @@ sub B::IO::bytecode {
 
     $io->B::PVMG::bytecode;
     ldsv($ix);
-    print "xio_top_gv $top_gvix\n";
-    print "xio_fmt_gv $fmt_gvix\n";
-    print "xio_bottom_gv $bottom_gvix\n";
+    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)) {
-	printf "newpv %s\nxio_%s\n", pvstring($io->$field()), lc($field);
+	asmf "newpv %s\nxio_%s\n", pvstring($io->$field()), lc($field);
     }
     foreach $field (qw(LINES PAGE PAGE_LEN LINES_LEFT SUBPROCESS)) {
-	printf "xio_%s %d\n", lc($field), $io->$field();
+	asmf "xio_%s %d\n", lc($field), $io->$field();
     }
-    printf "xio_type %s\nxio_flags 0x%x\n", cstring($io->IoTYPE), $io->IoFLAGS;
+    asmf "xio_type %s\nxio_flags 0x%x\n", cstring($io->IoTYPE), $io->IoFLAGS;
     $top_gv->bytecode;
     $fmt_gv->bytecode;
     $bottom_gv->bytecode;
@@ -660,7 +712,7 @@ sub bytecompile_object {
 sub B::GV::bytecodecv {
     my $gv = shift;
     my $cv = $gv->CV;
-    if ($$cv && !saved($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);
@@ -670,37 +722,40 @@ sub B::GV::bytecodecv {
 }
 
 sub save_call_queues {
-    if (ref(begin_av()) eq "B::AV") {	# this is just to save 'use Foo;' calls
-	for my $cv (begin_av->ARRAY) {
-	    my $name = $cv->STASH->NAME;
-	    next unless grep { $_ eq $name } @packages;
+    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;
-	    $op = $op->next while ($$op && ref $op ne "B::UNOP");
-	    if ($$op && $op->name eq 'require') { # should be first UNOP
-		$cv->bytecode;
-		printf "push_begin %d\n", $cv->objix;
+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;
+		}
+		$op = $op->next;
 	    }
 	}
     }
-    if (ref(init_av()) eq "B::AV") {
-	for my $cv (init_av->ARRAY) {
-	    next unless grep { $_ eq $cv->STASH->NAME } @packages;
+    if (init_av()->isa("B::AV")) {
+	for my $cv (init_av()->ARRAY) {
+	    next unless grep { $_ eq $cv->STASH->NAME; } @packages;
 	    $cv->bytecode;
-	    printf "push_init %d\n", $cv->objix;
+	    asmf "push_init %d\n", $cv->objix;
 	}
     }
-    if (ref(end_av()) eq "B::AV") {
-	for my $cv (end_av->ARRAY) {
-	    next unless grep { $_ eq $cv->STASH->NAME } @packages;
+    if (end_av()->isa("B::AV")) {
+	for my $cv (end_av()->ARRAY) {
+	    next unless grep { $_ eq $cv->STASH->NAME; } @packages;
 	    $cv->bytecode;
-	    printf "push_end %d\n", $cv->objix;
+	    asmf "push_end %d\n", $cv->objix;
 	}
     }
 }
 
 sub symwalk {
-     no strict 'refs';
-     my $ok = 1 if grep { (my $name = $_[0]) =~ s/::$//; $_ eq $name;} @packages;
+    no strict 'refs';
+    my $ok = 1 if grep { (my $name = $_[0]) =~ s/::$//; $_ eq $name;} @packages;
     if (grep { /^$_[0]/; } @packages) {
 	walksymtable(\%{"$_[0]"}, "bytecodecv", \&symwalk, $_[0]);
     }
@@ -713,41 +768,27 @@ 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);
-	our %packages;
 	walksymtable(\%{"main::"}, "bytecodecv", \&symwalk);
     } else {
 	die "No packages requested for compilation!\n";
     }
-    save_call_queues;
-    printf "main_root %d\n", main_root->objix;
-    printf "main_start %d\n", main_start->objix;
-    printf "curpad $curpadix\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 prepare_assemble {
-    my $newfh = IO::File->new_tmpfile;
-    select($newfh);
-    binmode $newfh;
-    return $newfh;
-}
-
-sub do_assemble {
-    my $fh = shift;
-    seek($fh, 0, 0); # rewind the temporary file
-    assemble_fh($fh, sub { print OUT @_ });
-}
-
 sub compile {
     my @options = @_;
     my ($option, $opt, $arg);
     open(OUT, ">&STDOUT");
     binmode OUT;
-    select(OUT);
+    select OUT;
   OPTION:
     while ($option = shift @options) {
 	if ($option =~ /^-(.)(.*)/) {
@@ -784,8 +825,6 @@ sub compile {
 	    }
 	} elsif ($opt eq "v") {
 	    $verbose = 1;
-	} elsif ($opt eq "m") { # XXX: NOP
-	    $module_only = 1;
 	} elsif ($opt eq "S") {
 	    $no_assemble = 1;
 	} elsif ($opt eq "f") {
@@ -804,9 +843,6 @@ sub compile {
 	    foreach $ref (values %optimise) {
 		$$ref = 0;
 	    }
-	    if ($arg >= 6) {
-		$strip_syntree = 1;
-	    }
 	    if ($arg >= 2) {
 		$bypass_nullops = 1;
 	    }
@@ -817,32 +853,27 @@ sub compile {
 	} elsif ($opt eq "P") {
 	    $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) { # XXX: unsupported and untested!
-	return sub {
-	    my $objname;
-	    my $newfh; 
-	    $newfh = prepare_assemble() unless $no_assemble;
-	    foreach $objname (@options) {
-		eval "bytecompile_object(\\$objname)";
-	    }
-	    do_assemble($newfh) unless $no_assemble;
-	}
+    if (@options) {
+	die "Extraneous options left on B::Bytecode commandline: @options\n";
     } else {
-	return sub {
-	    my $newfh; 
-	    $newfh = prepare_assemble() unless $no_assemble;
+	return sub { 
+	    newasm(\&apr) unless $no_assemble;
 	    bytecompile_main();
-	    do_assemble($newfh) unless $no_assemble;
-	}
+	    endasm() unless $no_assemble;
+	};
     }
 }
 
+sub apr { print @_; }
+
 1;
 
 __END__
@@ -912,18 +943,11 @@ which is only used by perl's internal compiler.
 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<-fstrip-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 C<goto label> statements from working.
-
 =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<-O6> adds B<-fstrip-syntax-tree>.
+B<-O2> adds B<-fbypass-nullops>.
 
 =item B<-D>
 
diff --git a/ext/B/O.pm b/ext/B/O.pm
index 98fdcf6..2ef91ed 100644
--- a/ext/B/O.pm
+++ b/ext/B/O.pm
@@ -1,5 +1,5 @@
 package O;
-use B qw(minus_c);
+use B qw(minus_c save_BEGINs);
 use Carp;    
 
 sub import {
diff --git a/ext/B/defsubs_h.PL b/ext/B/defsubs_h.PL
index b793be2..a2d400a 100644
--- a/ext/B/defsubs_h.PL
+++ b/ext/B/defsubs_h.PL
@@ -7,8 +7,8 @@ $out =~ s/_h$/.h/;
 open(OUT,">$out") || die "Cannot open $file:$!";
 print "Extracting $out...\n";
 foreach my $const (qw(AVf_REAL 
-		      HEf_SVKEY SVphv_SHAREKEYS
-		      SVf_READONLY
+		      HEf_SVKEY
+		      SVf_READONLY SVTYPEMASK
 		      GVf_IMPORTED_AV GVf_IMPORTED_HV
 		      GVf_IMPORTED_SV GVf_IMPORTED_CV
 		      SVf_IOK SVf_IVisUV SVf_NOK SVf_POK
diff --git a/ext/ByteLoader/ByteLoader.pm b/ext/ByteLoader/ByteLoader.pm
index 286d746..9c8c84d 100644
--- a/ext/ByteLoader/ByteLoader.pm
+++ b/ext/ByteLoader/ByteLoader.pm
@@ -2,7 +2,7 @@ package ByteLoader;
 
 use XSLoader ();
 
-$VERSION = 0.03;
+$VERSION = 0.04;
 
 XSLoader::load 'ByteLoader', $VERSION;
 
@@ -17,10 +17,10 @@ ByteLoader - load byte compiled perl code
 
 =head1 SYNOPSIS
 
-  use ByteLoader 0.03;
+  use ByteLoader 0.04;
   <byte code>
 
-  use ByteLoader 0.03;
+  use ByteLoader 0.04;
   <byte code>
 
 =head1 DESCRIPTION
diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs
index cfabf33..d3b4351 100644
--- a/ext/ByteLoader/ByteLoader.xs
+++ b/ext/ByteLoader/ByteLoader.xs
@@ -4,14 +4,96 @@
 #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) <= 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 *((char *) 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);
+	SvCUR_set (data->datasv, len);
+      } else {
+	*start = '\0';	/* Avoid call to memmove. */
+	SvCUR_set (data->datasv, 0);
+      }
+      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(pTHXo_ int idx, SV *buf_sv, int maxlen)
 {
     dTHR;
     OP *saveroot = PL_main_root;
     OP *savestart = PL_main_start;
+    struct byteloader_state bstate;
+    struct byteloader_fdata data;
+
+    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;
 
-    byterun(aTHXo);
+    byterun(aTHXo_ &bstate);
 
     if (PL_in_eval) {
         OP *o;
@@ -37,8 +119,12 @@ PROTOTYPES:	ENABLE
 
 void
 import(...)
+  PREINIT:
+    SV *sv = newSVpvn ("", 0);
   PPCODE:
-    filter_add(byteloader_filter, NULL);
+    if (!sv)
+      croak ("Could not allocate ByteLoader buffers");
+    filter_add(byteloader_filter, sv);
 
 void
 unimport(...)
diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index d5bd32c..296c2af 100644
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -5,11 +5,12 @@ typedef char *op_tr_array;
 typedef int comment_t;
 typedef SV *svindex;
 typedef OP *opindex;
+typedef char *pvindex;
 typedef IV IV64;
 
 #define BGET_FREAD(argp, len, nelem)	\
-	 PerlIO_read(PL_rsfp,(char*)(argp),(len)*(nelem))
-#define BGET_FGETC() PerlIO_getc(PL_rsfp)
+	 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)
@@ -22,14 +23,14 @@ typedef IV IV64;
 #define BGET_PV(arg)	STMT_START {					\
 	BGET_U32(arg);							\
 	if (arg) {							\
-	    New(666, bytecode_pv.xpv_pv, arg, char);			\
-	    PerlIO_read(PL_rsfp, (void*)bytecode_pv.xpv_pv, arg);	\
-	    bytecode_pv.xpv_len = arg;					\
-	    bytecode_pv.xpv_cur = arg - 1;				\
+	    New(666, bstate->bs_pv.xpv_pv, arg, char);			\
+	    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 {							\
-	    bytecode_pv.xpv_pv = 0;					\
-	    bytecode_pv.xpv_len = 0;					\
-	    bytecode_pv.xpv_cur = 0;					\
+	    bstate->bs_pv.xpv_pv = 0;					\
+	    bstate->bs_pv.xpv_len = 0;					\
+	    bstate->bs_pv.xpv_cur = 0;					\
 	}								\
     } STMT_END
 
@@ -66,7 +67,7 @@ typedef IV IV64;
 	    arg = (I32)lo;				\
 	}						\
 	else {						\
-	    bytecode_iv_overflows++;			\
+	    bstate->bs_iv_overflows++;			\
 	    arg = 0;					\
 	}						\
     } STMT_END
@@ -79,7 +80,7 @@ typedef IV IV64;
 	arg = (char *) ary;				\
     } while (0)
 
-#define BGET_pvcontents(arg)	arg = bytecode_pv.xpv_pv
+#define BGET_pvcontents(arg)	arg = bstate->bs_pv.xpv_pv
 #define BGET_strconst(arg) STMT_START {	\
 	for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \
 	arg = PL_tokenbuf;			\
@@ -92,14 +93,21 @@ typedef IV IV64;
     } STMT_END
 
 #define BGET_objindex(arg, type) STMT_START {	\
-	U32 ix;					\
 	BGET_U32(ix);				\
-	arg = (type)bytecode_obj_list[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) sv = specialsv_list[arg]
+#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
@@ -111,22 +119,22 @@ 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 = bytecode_pv.xpv_cur
+#define BSET_mg_pv(mg, arg)	mg->mg_ptr = arg; mg->mg_len = bstate->bs_pv.xpv_cur
 #define BSET_sv_upgrade(sv, arg)	(void)SvUPGRADE(sv, arg)
 #define BSET_xpv(sv)	do {	\
-	SvPV_set(sv, bytecode_pv.xpv_pv);	\
-	SvCUR_set(sv, bytecode_pv.xpv_cur);	\
-	SvLEN_set(sv, bytecode_pv.xpv_len);	\
+	SvPV_set(sv, bstate->bs_pv.xpv_pv);	\
+	SvCUR_set(sv, bstate->bs_pv.xpv_cur);	\
+	SvLEN_set(sv, bstate->bs_pv.xpv_len);	\
     } while (0)
 #define BSET_av_extend(sv, arg)	av_extend((AV*)sv, arg)
 
 #define BSET_av_push(sv, arg)	av_push((AV*)sv, arg)
 #define BSET_hv_store(sv, arg)	\
-	hv_store((HV*)sv, bytecode_pv.xpv_pv, bytecode_pv.xpv_cur, arg, 0)
+	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)
 #define BSET_pregcomp(o, arg) \
 	((PMOP*)o)->op_pmregexp = arg ? \
-		CALLREGCOMP(aTHX_ arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0
+		CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv_cur, ((PMOP*)o)) : 0
 #define BSET_newsv(sv, arg)				\
 	STMT_START {					\
 	    sv = (arg == SVt_PVAV ? (SV*)newAV() :	\
@@ -143,9 +151,7 @@ typedef IV IV64;
     } STMT_END
 
 #define BSET_ret(foo) STMT_START {			\
-	if (bytecode_obj_list)				\
-	    Safefree(bytecode_obj_list);		\
-	LEAVE;						\
+	Safefree(bstate->bs_obj_list);			\
 	return;						\
     } STMT_END
 
@@ -198,39 +204,51 @@ typedef IV IV64;
 	    av_store(PL_endav, 0, cv);							\
 	} STMT_END
 #define BSET_OBJ_STORE(obj, ix)			\
-	(I32)ix > bytecode_obj_list_fill ?	\
-	bset_obj_store(aTHXo_ obj, (I32)ix) : (bytecode_obj_list[ix] = obj)
-#define BYTECODE_HEADER_CHECK				\
-	STMT_START {					\
-	    U32 sz;					\
-	    strconst str;				\
-	    char *badpart;				\
-							\
-	    BGET_U32(sz); /* Magic: 'PLBC' */		\
-	    if (sz != 0x43424c50) {			\
-		badpart = "bad magic";			\
-		goto bch_fail;				\
-	    }						\
-	    BGET_strconst(str);	/* archname */		\
-	    if (strNE(str, ARCHNAME)) {			\
-		badpart = "wrong architecture";		\
-		goto bch_fail;				\
-	    }						\
-	    BGET_U32(sz); /* ivsize */			\
-	    if (sz != IVSIZE) {				\
-		badpart = "different IVSIZE";		\
-		goto bch_fail;				\
-	    }						\
-	    BGET_U32(sz); /* ptrsize */			\
-	    if (sz != PTRSIZE) {			\
-		badpart = "different PTRSIZE";		\
-		goto bch_fail;				\
-	    }						\
-	    BGET_strconst(str); /* byteorder */		\
-	    if (strNE(str, STRINGIFY(BYTEORDER))) {	\
-		badpart = "different byteorder";	\
-	bch_fail:					\
-		Perl_croak(aTHX_ "Invalid bytecode for this architecture: %s\n",	\
-				badpart);		\
-	    }						\
+	(I32)ix > bstate->bs_obj_list_fill ?	\
+	bset_obj_store(aTHXo_ bstate, obj, (I32)ix) : (bstate->bs_obj_list[ix] = obj)
+
+/* 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 'require 5.6.0' 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, 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_FAIL("bad magic (want 0x43424c50, got %#x)", sz, 0);		\
+	    }							\
+	    BGET_strconst(str);	/* archname */			\
+	    if (strNE(str, ARCHNAME)) {				\
+		HEADER_FAIL("wrong architecture (want %s, you have %s)",str,ARCHNAME);	\
+	    }							\
+	    BGET_strconst(str); /* ByteLoader version */	\
+	    if (strNE(str, VERSION)) {				\
+		HEADER_FAIL("mismatched ByteLoader versions (want %s, you have %s)",	\
+			str, VERSION);				\
+	    }							\
+	    BGET_U32(sz); /* ivsize */				\
+	    if (sz != IVSIZE) {					\
+		HEADER_FAIL("different IVSIZE", 0, 0);		\
+	    }							\
+	    BGET_U32(sz); /* ptrsize */				\
+	    if (sz != PTRSIZE) {				\
+		HEADER_FAIL("different PTRSIZE", 0, 0);		\
+	    }							\
+	    BGET_strconst(str); /* byteorder */			\
+	    if (strNE(str, STRINGIFY(BYTEORDER))) {		\
+		HEADER_FAIL("different byteorder", 0, 0);	\
+	    }							\
+	    Safefree(str);					\
 	} STMT_END