Development to pre-alpha4

p4raw-id: //depot/perlext/Compiler@11

23 files changed, 831 insertions, 291 deletions

diff --git a/B.pm b/B.pm
index 4a9a202325..974b72e8cf 100644
--- a/B.pm
+++ b/B.pm
@@ -10,10 +10,10 @@ require DynaLoader;
 require Exporter;
 @ISA = qw(Exporter DynaLoader);
 @EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname
-		class peekop cast_I32 ad cstring cchar hash
+		class peekop cast_I32 cstring cchar hash
 		main_root main_start main_cv svref_2object
-		walkoptree walkoptree_exec walksymtable
-		comppadlist sv_undef compile_stats timing_info);
+		walkoptree walkoptree_slow walkoptree_exec walksymtable
+		parents comppadlist sv_undef compile_stats timing_info);
 
 use strict;
 @B::SV::ISA = 'B::OBJECT';
@@ -56,6 +56,7 @@ use strict;
 
 my $debug;
 my $op_count = 0;
+my @parents = ();
 
 sub debug {
     my ($class, $value) = @_;
@@ -66,11 +67,6 @@ sub debug {
 # add to .xs for perl5.002
 sub OPf_KIDS () { 4 }
 
-sub ad {
-    my $obj = shift;
-    return $$obj;
-}
-
 sub class {
     my $obj = shift;
     my $name = ref $obj;
@@ -78,23 +74,27 @@ sub class {
     return $name;
 }
 
+sub parents { \@parents }
+
 # For debugging
 sub peekop {
     my $op = shift;
     return sprintf("%s (0x%x) %s", class($op), $$op, $op->ppaddr);
 }
 
-sub walkoptree {
+sub walkoptree_slow {
     my($op, $method, $level) = @_;
     $op_count++; # just for statistics
     $level ||= 0;
     warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
     $op->$method($level);
-    if (ad($op) && ($op->flags & OPf_KIDS)) {
+    if ($$op && ($op->flags & OPf_KIDS)) {
 	my $kid;
+	unshift(@parents, $op);
 	for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
-	    walkoptree($kid, $method, $level + 1);
+	    walkoptree_slow($kid, $method, $level + 1);
 	}
+	shift @parents;
     }
 }
 
@@ -112,13 +112,13 @@ sub timing_info {
 my %symtable;
 sub savesym {
     my ($obj, $value) = @_;
-#    warn(sprintf("savesym: sym_%x => %s\n", ad($obj), $value)); # debug
-    $symtable{sprintf("sym_%x", ad($obj))} = $value;
+#    warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
+    $symtable{sprintf("sym_%x", $$obj)} = $value;
 }
 
 sub objsym {
     my $obj = shift;
-    return $symtable{sprintf("sym_%x", ad($obj))};
+    return $symtable{sprintf("sym_%x", $$obj)};
 }
 
 sub walkoptree_exec {
@@ -131,7 +131,7 @@ sub walkoptree_exec {
 	    print $prefix, "goto $sym\n";
 	    return;
 	}
-	savesym($op, sprintf("%s (0x%lx)", class($op), ad($op)));
+	savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
 	$op->$method($level);
 	$ppname = $op->ppaddr;
 	if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile|entertry)$/) {
@@ -140,7 +140,7 @@ sub walkoptree_exec {
 	    print $prefix, "}\n";
 	} elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
 	    my $pmreplstart = $op->pmreplstart;
-	    if (ad($pmreplstart)) {
+	    if ($$pmreplstart) {
 		print $prefix, "PMREPLSTART => {\n";
 		walkoptree_exec($pmreplstart, $method, $level + 1);
 		print $prefix, "}\n";
@@ -173,7 +173,7 @@ sub walkoptree_exec {
 	    print $prefix, "}\n";
 	} elsif ($ppname eq "pp_subst") {
 	    my $replstart = $op->pmreplstart;
-	    if (ad($replstart)) {
+	    if ($$replstart) {
 		print $prefix, "SUBST => {\n";
 		walkoptree_exec($replstart, $method, $level + 1);
 		print $prefix, "}\n";
@@ -183,14 +183,15 @@ sub walkoptree_exec {
 }
 
 sub walksymtable {
-    my ($symref, $method, $recurse) = @_;
+    my ($symref, $method, $recurse, $prefix) = @_;
     my $sym;
     no strict 'vars';
     local(*glob);
     while (($sym, *glob) = each %$symref) {
 	if ($sym =~ /::$/) {
+	    $sym = $prefix . $sym;
 	    if ($sym ne "main::" && &$recurse($sym)) {
-		walksymtable(\%glob, $method, $recurse);
+		walksymtable(\%glob, $method, $recurse, $sym);
 	    }
 	} else {
 	    svref_2object(\*glob)->EGV->$method();
diff --git a/B.xs b/B.xs
index a89b5302df..4934b06955 100644
--- a/B.xs
+++ b/B.xs
@@ -255,6 +255,31 @@ char *str;
 }    
 #endif /* INDIRECT_BGET_MACROS */
 
+void
+walkoptree(opsv, method)
+SV *opsv;
+char *method;
+{
+    dSP;
+    OP *o;
+    
+    if (!SvROK(opsv))
+	croak("opsv is not a reference");
+    opsv = sv_mortalcopy(opsv);
+    o = (OP*)SvIV((SV*)SvRV(opsv));
+    PUSHMARK(sp);
+    XPUSHs(opsv);
+    PUTBACK;
+    perl_call_method(method, G_DISCARD);
+    if (o && (o->op_flags & OPf_KIDS)) {
+	OP *kid;
+	for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
+	    /* Use the same opsv. Rely on methods not to mess it up. */
+	    sv_setiv(newSVrv(opsv, cc_opclassname(kid)), (IV)kid);
+	    walkoptree(opsv, method);
+	}
+    }
+}
 
 typedef OP	*B__OP;
 typedef UNOP	*B__UNOP;
@@ -322,8 +347,18 @@ MODULE = B	PACKAGE = B
 
 
 void
+walkoptree(opsv, method)
+	SV *	opsv
+	char *	method
+
+int
 byteload_fh(fp)
 	FILE *	fp
+    CODE:
+	byteload_fh(fp);
+	RETVAL = 1;
+    OUTPUT:
+	RETVAL
 
 void
 byteload_string(str)
@@ -388,6 +423,7 @@ cchar(sv)
 #define OP_next(o)	o->op_next
 #define OP_sibling(o)	o->op_sibling
 #define OP_ppaddr(o)	ppnames[o->op_type]
+#define OP_desc(o)	op_desc[o->op_type]
 #define OP_targ(o)	o->op_targ
 #define OP_type(o)	o->op_type
 #define OP_seq(o)	o->op_seq
@@ -408,6 +444,10 @@ char *
 OP_ppaddr(o)
 	B::OP		o
 
+char *
+OP_desc(o)
+	B::OP		o
+
 U16
 OP_targ(o)
 	B::OP		o
diff --git a/B/Bblock.pm b/B/Bblock.pm
index cd43d373da..2adca70b4b 100644
--- a/B/Bblock.pm
+++ b/B/Bblock.pm
@@ -3,7 +3,7 @@ use Exporter ();
 @ISA = "Exporter";
 @EXPORT_OK = qw(find_leaders);
 
-use B qw(ad peekop walkoptree walkoptree_exec
+use B qw(peekop walkoptree walkoptree_exec
 	 main_root main_start svref_2object);
 use B::Terse;
 use strict;
@@ -13,8 +13,8 @@ my @bblock_ends;
 
 sub mark_leader {
     my $op = shift;
-    if (ad($op)) {
-	$bblock->{ad($op)} = $op;
+    if ($$op) {
+	$bblock->{$$op} = $op;
     }
 }
 
@@ -37,8 +37,8 @@ sub walk_bblocks {
     while ($leader = shift @leaders) {
 	$lastop = $leader;
 	$op = $leader->next;
-	while (ad($op) && !exists($bblock->{ad($op)})) {
-	    $bblock->{ad($op)} = $leader;
+	while ($$op && !exists($bblock->{$$op})) {
+	    $bblock->{$$op} = $leader;
 	    $lastop = $op;
 	    $op = $op->next;
 	}
@@ -47,7 +47,7 @@ sub walk_bblocks {
     foreach $bb (@bblock_ends) {
 	($leader, $lastop) = @$bb;
 	printf "%s .. %s\n", peekop($leader), peekop($lastop);
-	for ($op = $leader; ad($op) != ad($lastop); $op = $op->next) {
+	for ($op = $leader; $$op != $$lastop; $op = $op->next) {
 	    printf "    %s\n", peekop($op);
 	}
 	printf "    %s\n", peekop($lastop);
@@ -108,7 +108,7 @@ sub B::PMOP::mark_if_leader {
     my $op = shift;
     if ($op->ppaddr ne "pp_pushre") {
 	my $replroot = $op->pmreplroot;
-	if (ad($replroot)) {
+	if ($$replroot) {
 	    mark_leader($replroot);
 	    mark_leader($op->next);
 	    mark_leader($op->pmreplstart);
diff --git a/B/Bytecode.pm b/B/Bytecode.pm
index 9e763de6fe..81d00b34d9 100644
--- a/B/Bytecode.pm
+++ b/B/Bytecode.pm
@@ -9,7 +9,7 @@ package B::Bytecode;
 use strict;
 use Carp;
 
-use B qw(ad minus_c main_cv main_root main_start comppadlist
+use B qw(minus_c main_cv main_root main_start comppadlist
 	 class peekop walkoptree svref_2object cstring walksymtable);
 use B::Asmdata qw(@optype @specialsv_name);
 use B::Assembler qw(assemble_fh);
@@ -97,9 +97,9 @@ sub pvstring {
     }
 }
 
-sub saved { $saved{ad($_[0])} }
-sub mark_saved { $saved{ad($_[0])} = 1 }
-sub unmark_saved { $saved{ad($_[0])} = 0 }
+sub saved { $saved{${$_[0]}} }
+sub mark_saved { $saved{${$_[0]}} = 1 }
+sub unmark_saved { $saved{${$_[0]}} = 0 }
 
 my $debug = 0;
 sub debug { $debug = shift }
@@ -107,7 +107,7 @@ sub debug { $debug = shift }
 sub B::OBJECT::nyi {
     my $obj = shift;
     warn sprintf("bytecode save method for %s (0x%x) not yet implemented\n",
-		 class($obj), ad($obj));
+		 class($obj), $$obj);
 }
 
 #
@@ -178,7 +178,7 @@ sub B::OP::bytecode {
     my $type = $op->type;
 
     if ($bypass_nullops) {
-	$next = $next->next while ad($next) && $next->type == 0;
+	$next = $next->next while $$next && $next->type == 0;
     }
     $nextix = $next->objix;
 
@@ -315,7 +315,7 @@ sub B::PMOP::bytecode {
     #my $pmnextix = $op->pmnext->objix;
 
     $short->bytecode;
-    if (ad($replroot)) {
+    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...
@@ -379,7 +379,9 @@ sub B::NV::bytecode {
 sub B::RV::bytecode {
     my $sv = shift;
     return if saved($sv);
-    my $rvix = $sv->RV->objix;
+    my $rv = $sv->RV;
+    my $rvix = $rv->objix;
+    $rv->bytecode;
     $sv->B::SV::bytecode;
     print "xrv $rvix\n";
 }
@@ -512,9 +514,19 @@ sub B::HV::bytecode {
     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.
-	#
-	# XXX We don't yet save the contents of non-empty HVs
+	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) {
+	    printf("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;
     }
 }
@@ -564,7 +576,7 @@ sub B::CV::bytecode {
     my @ixes = map($_->objix, @subfields);
     # Save OP tree from CvROOT (first element of @subfields)
     my $root = shift @subfields;
-    if (ad($root)) {
+    if ($$root) {
 	walkoptree($root, "bytecode");
     }
     # Reset sv register for $cv (since above ->objix calls stomped on it)
@@ -625,10 +637,10 @@ sub bytecompile_object {
 sub B::GV::bytecodecv {
     my $gv = shift;
     my $cv = $gv->CV;
-    if (ad($cv) && !saved($cv)) {
+    if ($$cv && !saved($cv)) {
 	if ($debug_cv) {
 	    warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
-			 $gv->STASH->NAME, $gv->NAME, ad($cv), ad($gv));
+			 $gv->STASH->NAME, $gv->NAME, $$cv, $$gv);
 	}
 	$gv->bytecode;
     }
@@ -698,7 +710,7 @@ sub compile {
 		    B->debug(1);
 		} elsif ($arg eq "a") {
 		    B::Assembler::debug(1);
-		} elsif ($arg eq "D") {
+		} elsif ($arg eq "C") {
 		    $debug_cv = 1;
 		}
 	    }
diff --git a/B/C.pm b/B/C.pm
index 338b9c9a2c..ab38046e2c 100644
--- a/B/C.pm
+++ b/B/C.pm
@@ -12,7 +12,7 @@ use Exporter ();
 	       output_main set_callback save_unused_subs objsym);
 
 use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start
-	 ad peekop class cstring cchar svref_2object compile_stats
+	 peekop class cstring cchar svref_2object compile_stats
 	 comppadlist hash);
 use B::Asmdata qw(@specialsv_name);
 
@@ -78,13 +78,13 @@ sub AVf_REAL () { 1 }
 
 sub savesym {
     my ($obj, $value) = @_;
-#    warn(sprintf("savesym: sym_%x => %s\n", ad($obj), $value)); # debug
-    $symtable{sprintf("sym_%x", ad($obj))} = $value;
+#    warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
+    $symtable{sprintf("sym_%x", $$obj)} = $value;
 }
 
 sub objsym {
     my $obj = shift;
-    return $symtable{sprintf("sym_%x", ad($obj))};
+    return $symtable{sprintf("sym_%x", $$obj)};
 }
 
 sub getsym {
@@ -127,7 +127,7 @@ sub B::OP::save {
     $nullop_count++ unless $type;
     push(@op_list,
 	 sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x",
-		 ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ,
+		 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
 		 $type, $op_seq, $op->flags, $op->private));
     savesym($op, "&op_list[$#op_list]");
 }
@@ -158,8 +158,8 @@ sub B::UNOP::save {
     my ($op, $level) = @_;
     push(@unop_list,
 	 sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x",
-		 ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ,
-		 $op->type, $op_seq, $op->flags,$op->private,ad($op->first)));
+		 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
+		 $op->type, $op_seq, $op->flags,$op->private,${$op->first}));
     savesym($op, "(OP*)&unop_list[$#unop_list]");
 }
 
@@ -167,9 +167,9 @@ sub B::BINOP::save {
     my ($op, $level) = @_;
     push(@binop_list,
 	 sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x",
-		 ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ,
+		 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
 		 $op->type, $op_seq, $op->flags, $op->private,
-		 ad($op->first), ad($op->last)));
+		 ${$op->first}, ${$op->last}));
     savesym($op, "(OP*)&binop_list[$#binop_list]");
 }
 
@@ -177,9 +177,9 @@ sub B::LISTOP::save {
     my ($op, $level) = @_;
     push(@listop_list, sprintf(
 	"sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x, %u",
-	ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ,
-	$op->type, $op_seq, $op->flags, $op->private, ad($op->first),
-	ad($op->last), $op->children));
+	${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
+	$op->type, $op_seq, $op->flags, $op->private, ${$op->first},
+	${$op->last}, $op->children));
     savesym($op, "(OP*)&listop_list[$#listop_list]");
 }
 
@@ -187,9 +187,9 @@ sub B::LOGOP::save {
     my ($op, $level) = @_;
     push(@logop_list,
 	 sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x",
-		 ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ,
+		 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
 		 $op->type, $op_seq, $op->flags, $op->private,
-		 ad($op->first), ad($op->other)));
+		 ${$op->first}, ${$op->other}));
     savesym($op, "(OP*)&logop_list[$#logop_list]");
 }
 
@@ -197,9 +197,9 @@ sub B::CONDOP::save {
     my ($op, $level) = @_;
     push(@condop_list, sprintf(
 	"sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x, sym_%x",
-	ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ,
-	$op->type, $op_seq, $op->flags, $op->private, ad($op->first),
-	ad($op->true), ad($op->false)));
+	${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
+	$op->type, $op_seq, $op->flags, $op->private, ${$op->first},
+	${$op->true}, ${$op->false}));
     savesym($op, "(OP*)&condop_list[$#condop_list]");
 }
 
@@ -211,9 +211,9 @@ sub B::LOOP::save {
     push(@loop_list, sprintf(
 	"sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, "
 	."sym_%x, sym_%x, %u, sym_%x, sym_%x, sym_%x",
-	ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ, $op->type,
-	$op_seq, $op->flags, $op->private, ad($op->first), ad($op->last),
-	$op->children, ad($op->redoop), ad($op->nextop), ad($op->lastop)));
+	${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type,
+	$op_seq, $op->flags, $op->private, ${$op->first}, ${$op->last},
+	$op->children, ${$op->redoop}, ${$op->nextop}, ${$op->lastop}));
     savesym($op, "(OP*)&loop_list[$#loop_list]");
 }
 
@@ -221,7 +221,7 @@ sub B::PVOP::save {
     my ($op, $level) = @_;
     push(@pvop_list,
 	 sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
-		 ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ,
+		 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
 		 $op->type, $op_seq, $op->flags, $op->private,
 		 cstring($op->pv)));
     savesym($op, "(OP*)&pvop_list[$#pvop_list]");
@@ -229,13 +229,13 @@ sub B::PVOP::save {
 
 sub B::SVOP::save {
     my ($op, $level) = @_;
+    my $svsym = $op->sv->save;
     push(@svop_list,
-	 sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, (SV*)sym_%x",
-		 ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ,
-		 $op->type, $op_seq, $op->flags, $op->private, ad($op->sv)));
+	 sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+		 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
+		 $op->type, $op_seq, $op->flags, $op->private, "(SV*)$svsym"));
     savesym($op, "(OP*)&svop_list[$#svop_list]");
-#    warn sprintf("svop saving sv %s 0x%x\n", ref($op->sv), ad($op->sv));#debug
-    $op->sv->save;
+#    warn sprintf("svop saving sv %s 0x%x\n", ref($op->sv), ${$op->sv});#debug
 }
 
 sub B::GVOP::save {
@@ -243,7 +243,7 @@ sub B::GVOP::save {
     my $gvsym = $op->gv->save;
     push(@gvop_list,
 	 sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, Nullgv",
-		 ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ,
+		 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
 		 $op->type, $op_seq, $op->flags, $op->private));
     push_init(sprintf("gvop_list[$#gvop_list].op_gv = %s;", $gvsym));
     savesym($op, "(OP*)&gvop_list[$#gvop_list]");
@@ -258,7 +258,7 @@ sub B::COP::save {
     push(@cop_list,
 	 sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s, "
 		 ."Nullhv, Nullgv, %u, %d, %u",
-		 ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ,
+		 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
 		 $op->type, $op_seq, $op->flags, $op->private,
 		 cstring($op->label), $op->cop_seq, $op->arybase, $op->line));
     push_init(sprintf("cop_list[$#cop_list].cop_filegv = %s;", $gvsym),
@@ -271,11 +271,11 @@ sub B::PMOP::save {
     my $shortsym = $op->pmshort->save;
     my $replroot = $op->pmreplroot;
     my $replstart = $op->pmreplstart;
-    my $replrootfield = sprintf("sym_%x", ad($replroot));
-    my $replstartfield = sprintf("sym_%x", ad($replstart));
+    my $replrootfield = sprintf("sym_%x", $$replroot);
+    my $replstartfield = sprintf("sym_%x", $$replstart);
     my $gvsym;
     my $ppaddr = $op->ppaddr;
-    if (ad($replroot)) {
+    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...
@@ -293,9 +293,9 @@ sub B::PMOP::save {
     push(@pmop_list,
 	 sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x,"
 		 ." %u, %s, %s, 0, 0, %s, 0x%x, 0x%x, %u",
-		 ad($op->next), ad($op->sibling), $ppaddr, $op->targ,
+		 ${$op->next}, ${$op->sibling}, $ppaddr, $op->targ,
 		 $op->type, $op_seq, $op->flags, $op->private,
-		 ad($op->first), ad($op->last), $op->children,
+		 ${$op->first}, ${$op->last}, $op->children,
 		 $replrootfield, $replstartfield,
 		 $shortsym, $op->pmflags, $op->pmpermflags, $op->pmslen));
     my $pm = "pmop_list[$#pmop_list]";
@@ -474,13 +474,13 @@ sub B::PVMG::save {
 
 sub B::PVMG::save_magic {
     my ($sv) = @_;
-    #warn sprintf("saving magic for %s (0x%x)\n", class($sv), ad($sv)); # debug
+    #warn sprintf("saving magic for %s (0x%x)\n", class($sv), $$sv); # debug
     my $stash = $sv->SvSTASH;
-    if (ad($stash)) {
-	warn sprintf("xmg_stash = %s (0x%x)\n", $stash->NAME, ad($stash))
+    if ($$stash) {
+	warn sprintf("xmg_stash = %s (0x%x)\n", $stash->NAME, $$stash)
 	    if $debug_mg;
 	# XXX Hope stash is already going to be saved.
-	push_init(sprintf("SvSTASH(sym_%x) = sym_%x;", ad($sv), ad($stash)));
+	push_init(sprintf("SvSTASH(sym_%x) = sym_%x;", $$sv, $$stash));
     }
     my @mgchain = $sv->MAGIC;
     my ($mg, $type, $obj, $ptr);
@@ -491,11 +491,11 @@ sub B::PVMG::save_magic {
 	my $len = defined($ptr) ? length($ptr) : 0;
 	if ($debug_mg) {
 	    warn sprintf("magic %s (0x%x), obj %s (0x%x), type %s, ptr %s\n",
-			 class($sv), ad($sv), class($obj), ad($obj),
+			 class($sv), $$sv, class($obj), $$obj,
 			 cchar($type), cstring($ptr));
 	}
 	push_init(sprintf("sv_magic((SV*)sym_%x, (SV*)sym_%x, %s, %s, %d);",
-			  ad($sv), ad($obj), cchar($type),cstring($ptr),$len));
+			  $$sv, $$obj, cchar($type),cstring($ptr),$len));
     }
 }
 
@@ -509,11 +509,33 @@ sub B::RV::save {
     return savesym($sv, "&sv_list[$#sv_list]");
 }
 
+sub try_autoload {
+    my ($cvstashname, $cvname) = @_;
+    warn sprintf("No definition for sub %s::%s\n", $cvstashname, $cvname);
+    # Handle AutoLoader classes explicitly. Any more general AUTOLOAD
+    # use should be handled by the class itself.
+    no strict 'refs';
+    my $isa = \@{"$cvstashname\::ISA"};
+    if (grep($_ eq "AutoLoader", @$isa)) {
+	warn "Forcing immediate load of sub derived from AutoLoader\n";
+	# Tweaked version of AutoLoader::AUTOLOAD
+	my $dir = $cvstashname;
+	$dir =~ s(::)(/)g;
+	eval { require "auto/$dir/$cvname.al" };
+	if ($@) {
+	    warn qq(failed require "auto/$dir/$cvname.al": $@\n);
+	    return 0;
+	} else {
+	    return 1;
+	}
+    }
+}
+
 sub B::CV::save {
     my ($cv) = @_;
     my $sym = objsym($cv);
     if (defined($sym)) {
-#	warn sprintf("CV 0x%x already saved as $sym\n", ad($cv)); # debug
+#	warn sprintf("CV 0x%x already saved as $sym\n", $$cv); # debug
 	return $sym;
     }
     # Reserve a place on sv_list and xpvcv_list and record indices
@@ -523,72 +545,96 @@ sub B::CV::save {
     my $xpvcv_ix = $#xpvcv_list;
     # Save symbol now so that GvCV() doesn't recurse back to us via CvGV()
     $sym = savesym($cv, "&sv_list[$sv_ix]");
-    warn sprintf("saving CV 0x%x as $sym\n", ad($cv)) if $debug_cv;
+    warn sprintf("saving CV 0x%x as $sym\n", $$cv) if $debug_cv;
     my $gv = $cv->GV;
+    my $cvstashname = $gv->STASH->NAME;
+    my $cvname = $gv->NAME;
     my $root = $cv->ROOT;
+    my $cvxsub = $cv->XSUB;
+    if (!$$root && !$cvxsub) {
+	if (try_autoload($cvstashname, $cvname)) {
+	    # Recalculate root and xsub
+	    $root = $cv->ROOT;
+	    $cvxsub = $cv->XSUB;
+	    if ($$root || $cvxsub) {
+		warn "Successful forced autoload\n";
+	    }
+	}
+    }
     my $startfield = 0;
     my $padlist = $cv->PADLIST;
-    if (ad($root)) {
+    my $pv = $cv->PV;
+    my $xsub = 0;
+    my $xsubany = "Nullany";
+    if ($$root) {
 	warn sprintf("saving op tree for CV 0x%x, root = 0x%x\n",
-		     ad($cv), ad($root)) if $debug_cv;
+		     $$cv, $$root) if $debug_cv;
 	my $ppname;
-	if (ad($gv)) {
+	if ($$gv) {
 	    my $stashname = $gv->STASH->NAME;
 	    my $gvname = $gv->NAME;
-	    $ppname = "pp_sub_";
-	    $ppname .= $stashname eq "main" ? $gvname : "$stashname\::$gvname";
-	    $ppname =~ s/::/__/g;
-	} else {
+	    my $ppname = "";
+	    if ($gvname ne "__ANON__") {
+		$ppname = (${$gv->FORM} == $$cv) ? "pp_form_" : "pp_sub_";
+		$ppname .= ($stashname eq "main") ?
+			    $gvname : "$stashname\::$gvname";
+		$ppname =~ s/::/__/g;
+	    }
+	}
+	if (!$ppname) {
 	    $ppname = "pp_anonsub_$anonsub_index";
 	    $anonsub_index++;
 	}
 	$startfield = saveoptree($ppname, $root, $cv->START, $padlist->ARRAY);
 	warn sprintf("done saving op tree for CV 0x%x, name %s, root 0x%x\n",
-		     ad($cv), $ppname, ad($root)) if $debug_cv;
-    }
-    if (ad($padlist)) {
-	warn sprintf("saving PADLIST 0x%x for CV 0x%x\n",
-		     ad($padlist), ad($cv)) if $debug_cv;
-	$padlist->save;
-	warn sprintf("done saving PADLIST 0x%x for CV 0x%x\n",
-		     ad($padlist), ad($cv)) if $debug_cv;
+		     $$cv, $ppname, $$root) if $debug_cv;
+	if ($$padlist) {
+	    warn sprintf("saving PADLIST 0x%x for CV 0x%x\n",
+			 $$padlist, $$cv) if $debug_cv;
+	    $padlist->save;
+	    warn sprintf("done saving PADLIST 0x%x for CV 0x%x\n",
+			 $$padlist, $$cv) if $debug_cv;
+	}
     }
-    my $pv = $cv->PV;
-    my $xsub = 0;
-    my $xsubany = "Nullany";
-    if ($cv->XSUB) {
+    elsif ($cvxsub) {
 	$xsubany = sprintf("ANYINIT((void*)0x%x)", $cv->XSUBANY);
-	# Find out canonical name of XSUB function from EGV (I hope)
+	# Try to find out canonical name of XSUB function from EGV.
+	# XXX Doesn't work for XSUBs with PREFIX set (or anyone who
+	# calls newXS() manually with weird arguments).
 	my $egv = $gv->EGV;
 	my $stashname = $egv->STASH->NAME;
 	$stashname =~ s/::/__/g;
 	$xsub = sprintf("XS_%s_%s", $stashname, $egv->NAME);
 	push(@decl_list, "void $xsub _((CV*));");
     }
+    else {
+	warn "No definition for sub %s::%s (unable to autoload)\n",
+	    $cvstashname, $cvname; # debug
+    }
     $xpvcv_list[$xpvcv_ix] = sprintf(
 	"%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, sym_%lx, $xsub, $xsubany,".
 	" Nullgv, Nullgv, %d, sym_%lx, (CV*)sym_%lx, 0",
 	cstring($pv), length($pv), $cv->IVX, $cv->NVX, $startfield,
-	ad($cv->ROOT), $cv->DEPTH, ad($padlist), ad($cv->OUTSIDE));
-    if (ad($gv)) {
+	${$cv->ROOT}, $cv->DEPTH, $$padlist, ${$cv->OUTSIDE});
+    if ($$gv) {
 	$gv->save;
-	push_init(sprintf("CvGV(sym_%lx) = sym_%lx;",ad($cv),ad($gv)));
+	push_init(sprintf("CvGV(sym_%lx) = sym_%lx;",$$cv,$$gv));
 	warn sprintf("done saving GV 0x%x for CV 0x%x\n",
-		     ad($gv), ad($cv)) if $debug_cv;
+		     $$gv, $$cv) if $debug_cv;
     }
     my $filegv = $cv->FILEGV;
-    if (ad($filegv)) {
+    if ($$filegv) {
 	$filegv->save;
-	push_init(sprintf("CvFILEGV(sym_%lx) = sym_%lx;",ad($cv),ad($filegv)));
+	push_init(sprintf("CvFILEGV(sym_%lx) = sym_%lx;",$$cv,$$filegv));
 	warn sprintf("done saving FILEGV 0x%x for CV 0x%x\n",
-		     ad($filegv), ad($cv)) if $debug_cv;
+		     $$filegv, $$cv) if $debug_cv;
     }
     my $stash = $cv->STASH;
-    if (ad($stash)) {
+    if ($$stash) {
 	$stash->save;
-	push_init(sprintf("CvSTASH(sym_%lx) = sym_%lx;", ad($cv), ad($stash)));
+	push_init(sprintf("CvSTASH(sym_%lx) = sym_%lx;", $$cv, $$stash));
 	warn sprintf("done saving STASH 0x%x for CV 0x%x\n",
-		     ad($stash), ad($cv)) if $debug_cv;
+		     $$stash, $$cv) if $debug_cv;
     }
     $sv_list[$sv_ix] = sprintf("(XPVCV*)&xpvcv_list[%u], %lu, 0x%x",
 			       $xpvcv_ix, $cv->REFCNT + 1, $cv->FLAGS);
@@ -599,19 +645,19 @@ sub B::GV::save {
     my ($gv) = @_;
     my $sym = objsym($gv);
     if (defined($sym)) {
-	#warn sprintf("GV 0x%x already saved as $sym\n", ad($gv)); # debug
+	#warn sprintf("GV 0x%x already saved as $sym\n", $$gv); # debug
 	return $sym;
     } else {
 	my $ix = $gv_index++;
 	$sym = savesym($gv, "gv_list[$ix]");
-	#warn sprintf("Saving GV 0x%x as $sym\n", ad($gv)); # debug
+	#warn sprintf("Saving GV 0x%x as $sym\n", $$gv); # debug
     }
     my $gvname = $gv->NAME;
     my $name = cstring($gv->STASH->NAME . "::" . $gvname);
     #warn "GV name is $name\n"; # debug
     my $egv = $gv->EGV;
     my $egvsym;
-    if (ad($gv) != ad($egv)) {
+    if ($$gv != $$egv) {
 	#warn(sprintf("EGV name is %s, saving it now\n",
 	#	     $egv->STASH->NAME . "::" . $egv->NAME)); # debug
 	$egvsym = $egv->save;
@@ -636,44 +682,44 @@ sub B::GV::save {
 	# Don't save subfields of special GVs (*_, *1, *# and so on)
 #	warn "GV::save saving subfields\n"; # debug
 	my $gvsv = $gv->SV;
-	if (ad($gvsv)) {
-	    push_init(sprintf("GvSV($sym) = sym_%x;", ad($gvsv)));
+	if ($$gvsv) {
+	    push_init(sprintf("GvSV($sym) = sym_%x;", $$gvsv));
 #	    warn "GV::save \$$name\n"; # debug
 	    $gvsv->save;
 	}
 	my $gvav = $gv->AV;
-	if (ad($gvav)) {
-	    push_init(sprintf("GvAV($sym) = sym_%x;", ad($gvav)));
+	if ($$gvav) {
+	    push_init(sprintf("GvAV($sym) = sym_%x;", $$gvav));
 #	    warn "GV::save \@$name\n"; # debug
 	    $gvav->save;
 	}
 	my $gvhv = $gv->HV;
-	if (ad($gvhv)) {
-	    push_init(sprintf("GvHV($sym) = sym_%x;", ad($gvhv)));
+	if ($$gvhv) {
+	    push_init(sprintf("GvHV($sym) = sym_%x;", $$gvhv));
 #	    warn "GV::save \%$name\n"; # debug
 	    $gvhv->save;
 	}
 	my $gvcv = $gv->CV;
-	if (ad($gvcv)) {
-	    push_init(sprintf("GvCV($sym) = (CV*)sym_%x;", ad($gvcv)));
+	if ($$gvcv) {
+	    push_init(sprintf("GvCV($sym) = (CV*)sym_%x;", $$gvcv));
 #	    warn "GV::save &$name\n"; # debug
 	    $gvcv->save;
 	}
 	my $gvfilegv = $gv->FILEGV;
-	if (ad($gvfilegv)) {
-	    push_init(sprintf("GvFILEGV($sym) = sym_%x;",ad($gvfilegv)));
+	if ($$gvfilegv) {
+	    push_init(sprintf("GvFILEGV($sym) = sym_%x;",$$gvfilegv));
 #	    warn "GV::save GvFILEGV(*$name)\n"; # debug
 	    $gvfilegv->save;
 	}
 	my $gvform = $gv->FORM;
-	if (ad($gvform)) {
-	    push_init(sprintf("GvFORM($sym) = (CV*)sym_%x;", ad($gvform)));
+	if ($$gvform) {
+	    push_init(sprintf("GvFORM($sym) = (CV*)sym_%x;", $$gvform));
 #	    warn "GV::save GvFORM(*$name)\n"; # debug
 	    $gvform->save;
 	}
 	my $gvio = $gv->IO;
-	if (ad($gvio)) {
-	    push_init(sprintf("GvIOp($sym) = sym_%x;", ad($gvio)));
+	if ($$gvio) {
+	    push_init(sprintf("GvIOp($sym) = sym_%x;", $$gvio));
 #	    warn "GV::save GvIO(*$name)\n"; # debug
 	    $gvio->save;
 	}
@@ -692,7 +738,7 @@ sub B::AV::save {
     my $sv_list_index = $#sv_list;
     my $fill = $av->FILL;
     $av->save_magic;
-    warn sprintf("saving AV 0x%x FILL=$fill AvFLAGS=0x%x", ad($av), $avflags)
+    warn sprintf("saving AV 0x%x FILL=$fill AvFLAGS=0x%x", $$av, $avflags)
 	if $debug_av;
     # XXX AVf_REAL is wrong test: need to save comppadlist but not stack
     #if ($fill > -1 && ($avflags & AVf_REAL)) {
@@ -703,7 +749,7 @@ sub B::AV::save {
 	    my $i = 0;
 	    foreach $el (@array) {
 		warn sprintf("AV 0x%x[%d] = %s 0x%x\n",
-			     ad($av), $i++, class($el), ad($el));
+			     $$av, $i++, class($el), $$el);
 	    }
 	}
 	my @names = map($_->save, @array);
@@ -737,7 +783,7 @@ sub B::HV::save {
 	# A perl bug means HvPMROOT isn't altered when a PMOP is freed. Usually
 	# the only symptom is that sv_reset tries to reset the PMf_USED flag of
 	# a trashed op but we look at the trashed op_type and segfault.
-	#my $adpmroot = ad($hv->PMROOT);
+	#my $adpmroot = ${$hv->PMROOT};
 	my $adpmroot = 0;
 	push(@decl_list, "static HV *hv$hv_index;");
 	# XXX Beware of weird package names containing double-quotes, \n, ...?
@@ -794,8 +840,8 @@ sub B::IO::save {
     my ($field, $fsym);
     foreach $field (qw(TOP_GV FMT_GV BOTTOM_GV)) {
       	$fsym = $io->$field();
-	if (ad($fsym)) {
-	    push_init(sprintf("Io$field($sym) = (GV*)sym_%x;", ad($fsym)));
+	if ($$fsym) {
+	    push_init(sprintf("Io$field($sym) = (GV*)sym_%x;", $$fsym));
 	    $fsym->save;
 	}
     }
@@ -807,9 +853,9 @@ sub B::SV::save {
     my $sv = shift;
     # This is where we catch an honest-to-goodness Nullsv (which gets
     # blessed into B::SV explicitly) and any stray erroneous SVs.
-    return 0 unless ad($sv);
+    return 0 unless $$sv;
     confess sprintf("cannot save that type of SV: %s (0x%x)\n",
-		    class($sv), ad($sv));
+		    class($sv), $$sv);
 }
 
 sub output_all {
@@ -972,6 +1018,9 @@ extern "C" {
 
 #include "EXTERN.h"
 #include "perl.h"
+#ifndef PATCHLEVEL
+#include "patchlevel.h"
+#endif
 
 #ifdef __cplusplus
 }
@@ -1088,10 +1137,10 @@ sub B::GV::savecv {
     my $gv = shift;
     my $cv = $gv->CV;
     my $name = $gv->NAME;
-    if (ad($cv) && !objsym($cv) && !($name eq "bootstrap" && $cv->XSUB)) {
+    if ($$cv && !objsym($cv) && !($name eq "bootstrap" && $cv->XSUB)) {
 	if ($debug_cv) {
 	    warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
-			 $gv->STASH->NAME, $name, ad($cv), ad($gv));
+			 $gv->STASH->NAME, $name, $$cv, $$gv);
 	}
 	$gv->save;
     }
@@ -1099,20 +1148,41 @@ sub B::GV::savecv {
 
 sub save_unused_subs {
     my %search_pack;
-    map { $search_pack{"$_\::"} = 1 } @_;
+    map { $search_pack{$_} = 1 } @_;
     no strict qw(vars refs);
-    walksymtable(\%{"main::"}, "savecv", sub { exists($search_pack{$_[0]}) });
+    walksymtable(\%{"main::"}, "savecv", sub {
+	my $package = shift;
+	$package =~ s/::$//;
+	#warn "Considering $package\n";#debug
+	return 1 if exists $search_pack{$package};
+	#warn "    (nothing explicit)\n";#debug
+	# Omit the packages which we use (and which cause grief
+	# because of fancy "goto &$AUTOLOAD" stuff).
+	# XXX Surely there must be a nicer way to do this.
+	if ($package eq "FileHandle"
+	    || $package eq "Config"
+	    || $package eq "SelectSaver") {
+	    return 0;
+	}
+	my $m;
+	foreach $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH)) {
+	    if (defined(&{$package."::$m"})) {
+		warn "$package has method $m: -u$package assumed\n";#debug
+		return 1;
+	    }
+	}
+	return 0;
+    });
 }
 
 sub save_main {
     my $curpad_sym = (comppadlist->ARRAY)[1]->save;
     walkoptree(main_root, "save");
-    if (@unused_sub_packages) {
-	warn "done main optree, walking symtable for extras\n" if $debug_cv;
-	save_unused_subs(@unused_sub_packages);
-    }
-    push_init(sprintf("main_root = sym_%x;", ad(main_root)),
-	      sprintf("main_start = sym_%x;", ad(main_start)),
+    warn "done main optree, walking symtable for extras\n" if $debug_cv;
+    save_unused_subs(@unused_sub_packages);
+
+    push_init(sprintf("main_root = sym_%x;", ${main_root()}),
+	      sprintf("main_start = sym_%x;", ${main_start()}),
 	      "curpad = AvARRAY($curpad_sym);");
     output_boilerplate();
     print "\n";
diff --git a/B/CC.pm b/B/CC.pm
index a25e7e25fb..84ddfb9b43 100644
--- a/B/CC.pm
+++ b/B/CC.pm
@@ -7,7 +7,7 @@
 #
 package B::CC;
 use strict;
-use B qw(main_start main_root class comppadlist peekop svref_2object ad
+use B qw(main_start main_root class comppadlist peekop svref_2object
 	timing_info);
 use B::C qw(push_decl init_init push_init save_unused_subs objsym
 	    output_all output_boilerplate output_main);
@@ -36,6 +36,7 @@ sub CXt_LOOP () { 3 }
 sub CXt_SUBST () { 4 }
 sub CXt_BLOCK () { 5 }
 
+my $module;		# module name (when compiled with -m)
 my %done;		# hash keyed by $$op of leaders of basic blocks
 			# which have already been done.
 my $leaders;		# ref to hash of basic block leaders. Keys are $$op
@@ -53,7 +54,7 @@ my @padlist;		# Copy of current padlist so PMOP repl code can find it
 my @cxstack;		# Shadows the (compile-time) cxstack for next,last,redo
 my $jmpbuf_ix = 0;	# Next free index for dynamically allocated jmpbufs
 my %constobj;		# OP_CONST constants as Stackobj-derived objects
-			# keyed by ad($sv).
+			# keyed by $$sv.
 my $need_freetmps = 0;	# We may postpone FREETMPS to the end of each basic
 			# block or even to the end of each loop of blocks,
 			# depending on optimisation options.
@@ -550,9 +551,9 @@ sub pp_padsv {
 sub pp_const {
     my $op = shift;
     my $sv = $op->sv;
-    my $obj = $constobj{ad($sv)};
+    my $obj = $constobj{$$sv};
     if (!defined($obj)) {
-	$obj = $constobj{ad($sv)} = new B::Stackobj::Const ($sv);
+	$obj = $constobj{$$sv} = new B::Stackobj::Const ($sv);
     }
     push(@stack, $obj);
     return $op->next;
@@ -948,6 +949,25 @@ sub pp_entersub {
     return $op->next;
 }
 
+sub pp_enterwrite {
+    my $op = shift;
+    pp_entersub($op);
+}
+
+sub pp_leavewrite {
+    my $op = shift;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    # XXX Is this the right way to distinguish between it returning
+    # CvSTART(cv) (via doform) and pop_return()?
+    runtime("if (op) op = (*op->op_ppaddr)();");
+    runtime("SPAGAIN;");
+    $know_op = 0;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
 sub doeval {
     my $op = shift;
     $curcop->write_back;
@@ -1212,7 +1232,7 @@ sub pp_subst {
     write_back_stack();
     my $sym = doop($op);
     my $replroot = $op->pmreplroot;
-    if (ad($replroot)) {
+    if ($$replroot) {
 	runtime sprintf("if (op == ((PMOP*)(%s))->op_pmreplroot) goto %s;",
 			$sym, label($replroot));
 	$op->pmreplstart->save;
@@ -1228,7 +1248,11 @@ sub pp_substcont {
     write_back_stack();
     doop($op);
     my $pmop = $op->other;
-    my $pmopsym = objsym($pmop);
+    warn sprintf("substcont: op = %s, pmop = %s\n",
+		 peekop($op), peekop($pmop));#debug
+#    my $pmopsym = objsym($pmop);
+    my $pmopsym = $pmop->save; # XXX can this recurse?
+    warn "pmopsym = $pmopsym\n";#debug
     runtime sprintf("if (op == ((PMOP*)(%s))->op_pmreplstart) goto %s;",
 		    $pmopsym, label($pmop->pmreplstart));
     invalidate_lexicals();
@@ -1349,21 +1373,45 @@ sub cc_main {
     my @comppadlist = comppadlist->ARRAY;
     my $curpad_sym = $comppadlist[1]->save;
     my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
-    if (@unused_sub_packages) {
-	save_unused_subs(@unused_sub_packages);
-	# That only queues them. Now we need to generate code for them.
-	cc_recurse();
-    }
+    save_unused_subs(@unused_sub_packages);
+    cc_recurse();
+
     return if $errors;
-    push_init(sprintf("main_root = sym_%x;", ad(main_root)),
-	      "main_start = $start;",
-	      "curpad = AvARRAY($curpad_sym);");
+    if (!defined($module)) {
+	push_init(sprintf("main_root = sym_%x;", ${main_root()}),
+		  "main_start = $start;",
+		  "curpad = AvARRAY($curpad_sym);");
+    }
     output_boilerplate();
     print "\n";
     output_all("perl_init");
     output_runtime();
     print "\n";
     output_main();
+    if (defined($module)) {
+	my $cmodule = $module;
+	$cmodule =~ s/::/__/g;
+	print <<"EOT";
+
+#include "XSUB.h"
+XS(boot_$cmodule)
+{
+    dXSARGS;
+    perl_init();
+    ENTER;
+    SAVETMPS;
+    SAVESPTR(curpad);
+    SAVESPTR(op);
+    curpad = AvARRAY($curpad_sym);
+    op = $start;
+    pp_main(ARGS);
+    FREETMPS;
+    LEAVE;
+    ST(0) = &sv_yes;
+    XSRETURN(1);
+}
+EOT
+    }
     if ($debug_timings) {
 	warn sprintf("Done at %s\n", timing_info);
     }
@@ -1415,6 +1463,8 @@ sub compile {
 	    if ($arg >= 1) {
 		$freetmps_each_bblock = 1 unless $freetmps_each_loop;
 	    }
+	} elsif ($opt eq "m") {
+	    $module = $arg;
 	} elsif ($opt eq "D") {
             $arg ||= shift @options;
 	    foreach $arg (split(//, $arg)) {
diff --git a/B/Debug.pm b/B/Debug.pm
index 859e6f1c18..1a78f39165 100644
--- a/B/Debug.pm
+++ b/B/Debug.pm
@@ -1,12 +1,14 @@
 package B::Debug;
 use strict;
-use B qw(peekop class ad walkoptree walkoptree_exec
+use B qw(peekop class walkoptree walkoptree_exec
          main_start main_root cstring sv_undef);
 use B::Asmdata qw(@specialsv_name);
 
+my %done_gv;
+
 sub B::OP::debug {
     my ($op) = @_;
-    printf <<'EOT', class($op), ad($op), ad($op->next), ad($op->sibling), $op->ppaddr, $op->targ, $op->type, $op->seq, $op->flags, $op->private;
+    printf <<'EOT', class($op), $$op, ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op->seq, $op->flags, $op->private;
 %s (0x%lx)
 	op_next		0x%x
 	op_sibling	0x%x
@@ -22,26 +24,26 @@ EOT
 sub B::UNOP::debug {
     my ($op) = @_;
     $op->B::OP::debug();
-    printf "\top_first\t0x%x\n", ad($op->first);
+    printf "\top_first\t0x%x\n", ${$op->first};
 }
 
 sub B::BINOP::debug {
     my ($op) = @_;
     $op->B::UNOP::debug();
-    printf "\top_last\t\t0x%x\n", ad($op->last);
+    printf "\top_last\t\t0x%x\n", ${$op->last};
 }
 
 sub B::LOGOP::debug {
     my ($op) = @_;
     $op->B::UNOP::debug();
-    printf "\top_other\t0x%x\n", ad($op->other);
+    printf "\top_other\t0x%x\n", ${$op->other};
 }
 
 sub B::CONDOP::debug {
     my ($op) = @_;
     $op->B::UNOP::debug();
-    printf "\top_true\t0x%x\n", ad($op->true);
-    printf "\top_false\t0x%x\n", ad($op->false);
+    printf "\top_true\t0x%x\n", ${$op->true};
+    printf "\top_false\t0x%x\n", ${$op->false};
 }
 
 sub B::LISTOP::debug {
@@ -53,11 +55,11 @@ sub B::LISTOP::debug {
 sub B::PMOP::debug {
     my ($op) = @_;
     $op->B::LISTOP::debug();
-    printf "\top_pmreplroot\t0x%x\n", ad($op->pmreplroot);
-    printf "\top_pmreplstart\t0x%x\n", ad($op->pmreplstart);
-    printf "\top_pmnext\t0x%x\n", ad($op->pmnext);
+    printf "\top_pmreplroot\t0x%x\n", ${$op->pmreplroot};
+    printf "\top_pmreplstart\t0x%x\n", ${$op->pmreplstart};
+    printf "\top_pmnext\t0x%x\n", ${$op->pmnext};
     printf "\top_pmregexp->precomp\t%s\n", cstring($op->precomp);
-    printf "\top_pmshort\t0x%x\n", ad($op->pmshort);
+    printf "\top_pmshort\t0x%x\n", ${$op->pmshort};
     printf "\top_pmflags\t0x%x\n", $op->pmflags;
     printf "\top_pmslen\t%d\n", $op->pmslen;
     $op->pmshort->debug;
@@ -68,7 +70,7 @@ sub B::COP::debug {
     my ($op) = @_;
     $op->B::OP::debug();
     my ($filegv) = $op->filegv;
-    printf <<'EOT', $op->label, ad($op->stash), ad($filegv), $op->seq, $op->arybase, $op->line;
+    printf <<'EOT', $op->label, ${$op->stash}, $$filegv, $op->seq, $op->arybase, $op->line;
 	cop_label	%s
 	cop_stash	0x%x
 	cop_filegv	0x%x
@@ -82,7 +84,7 @@ EOT
 sub B::SVOP::debug {
     my ($op) = @_;
     $op->B::OP::debug();
-    printf "\top_sv\t\t0x%x\n", ad($op->sv);
+    printf "\top_sv\t\t0x%x\n", ${$op->sv};
     $op->sv->debug;
 }
 
@@ -95,21 +97,22 @@ sub B::PVOP::debug {
 sub B::GVOP::debug {
     my ($op) = @_;
     $op->B::OP::debug();
-    printf "\top_gv\t\t0x%x\n", ad($op->gv);
+    printf "\top_gv\t\t0x%x\n", ${$op->gv};
+    $op->gv->debug;
 }
 
 sub B::CVOP::debug {
     my ($op) = @_;
     $op->B::OP::debug();
-    printf "\top_cv\t\t0x%x\n", ad($op->cv);
+    printf "\top_cv\t\t0x%x\n", ${$op->cv};
 }
 
 sub B::NULL::debug {
     my ($sv) = @_;
-    if (ad($sv) == ad(sv_undef())) {
+    if ($$sv == ${sv_undef()}) {
 	print "&sv_undef\n";
     } else {
-	printf "NULL (0x%x)\n", ad($sv);
+	printf "NULL (0x%x)\n", $$sv;
     }
 }
 
@@ -119,7 +122,7 @@ sub B::SV::debug {
 	print class($sv), " = NULL\n";
 	return;
     }
-    printf <<'EOT', class($sv), ad($sv), $sv->REFCNT, $sv->FLAGS;
+    printf <<'EOT', class($sv), $$sv, $sv->REFCNT, $sv->FLAGS;
 %s (0x%x)
 	REFCNT		%d
 	FLAGS		0x%x
@@ -185,7 +188,7 @@ sub B::CV::debug {
     my ($padlist) = $sv->PADLIST;
     my ($gv) = $sv->GV;
     my ($filegv) = $sv->FILEGV;
-    printf <<'EOT', ad($stash), ad($start), ad($root), ad($gv), ad($filegv), $sv->DEPTH, $padlist, ad($sv->OUTSIDE);
+    printf <<'EOT', $$stash, $$start, $$root, $$gv, $$filegv, $sv->DEPTH, $padlist, ${$sv->OUTSIDE};
 	STASH		0x%x
 	START		0x%x
 	ROOT		0x%x
@@ -206,7 +209,7 @@ sub B::AV::debug {
     my ($av) = @_;
     $av->B::SV::debug;
     my(@array) = $av->ARRAY;
-    print "\tARRAY\t\t(", join(", ", map("0x" . ad($_), @array)), ")\n";
+    print "\tARRAY\t\t(", join(", ", map("0x" . $$_, @array)), ")\n";
     printf <<'EOT', scalar(@array), $av->MAX, $av->OFF, $av->AvFLAGS;
 	FILL		%d    
 	MAX		%d
@@ -217,13 +220,17 @@ EOT
     
 sub B::GV::debug {
     my ($gv) = @_;
+    if ($done_gv{$$gv}++) {
+	printf "GV %s::%s\n", $gv->STASH->NAME, $gv->NAME;
+	return;
+    }
     my ($sv) = $gv->SV;
     my ($av) = $gv->AV;
     my ($cv) = $gv->CV;
     $gv->B::SV::debug;
-    printf <<'EOT', $gv->NAME, $gv->STASH, ad($sv), $gv->GvREFCNT, $gv->FORM, ad($av), ad($gv->HV), ad($gv->EGV), ad($cv), $gv->CVGEN, $gv->LINE, $gv->FILEGV, $gv->GvFLAGS;
+    printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILEGV, $gv->GvFLAGS;
 	NAME		%s
-	STASH		0x%x
+	STASH		%s (0x%x)
 	SV		0x%x
 	GvREFCNT	%d
 	FORM		0x%x
diff --git a/B/Deparse.pm b/B/Deparse.pm
new file mode 100644
index 0000000000..9802cb4350
--- /dev/null
+++ b/B/Deparse.pm
@@ -0,0 +1,102 @@
+package B::Deparse;
+use strict;
+use B qw(peekop class main_root);
+
+my $debug;
+
+sub compile {
+    my $opt = shift;
+    if ($opt eq "-d") {
+	$debug = 1;
+    }
+    return sub { print deparse(main_root), "\n" }
+}
+
+sub ppname {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    warn sprintf("ppname %s\n", peekop($op)) if $debug;
+    no strict "refs";
+    return defined(&$ppname) ? &$ppname($op) : 0;
+}
+
+sub deparse {
+    my $op = shift;
+    my $expr;
+    warn sprintf("deparse %s\n", peekop($op)) if $debug;
+    while (ref($expr = ppname($op))) {
+	$op = $expr;
+	warn sprintf("Redirecting to %s\n", peekop($op)) if $debug;
+    }
+    return $expr;
+}
+
+sub pp_leave {
+    my $op = shift;
+    my ($child, $expr);
+    for ($child = $op->first; !$expr; $child = $child->sibling) {
+	$expr = ppname($child);
+    }
+    return $expr;
+}
+
+sub SWAP_CHILDREN () { 1 }
+
+sub binop {
+    my ($op, $opname, $flags) = @_;
+    my $left = $op->first;
+    my $right = $op->last;
+    if ($flags & SWAP_CHILDREN) {
+	($left, $right) = ($right, $left);
+    }
+    warn sprintf("binop deparsing first %s\n", peekop($op->first)) if $debug;
+    $left = deparse($left);
+    warn sprintf("binop deparsing last %s\n", peekop($op->last)) if $debug;
+    $right = deparse($right);
+    return "($left $opname $right)";
+}
+
+sub pp_add { binop($_[0], "+") }
+sub pp_multiply { binop($_[0], "*") }
+sub pp_subtract { binop($_[0], "-") }
+sub pp_divide { binop($_[0], "/") }
+sub pp_modulo { binop($_[0], "%") }
+sub pp_eq { binop($_[0], "==") }
+sub pp_ne { binop($_[0], "!=") }
+sub pp_lt { binop($_[0], "<") }
+sub pp_gt { binop($_[0], ">") }
+sub pp_ge { binop($_[0], ">=") }
+
+sub pp_sassign { binop($_[0], "=", SWAP_CHILDREN) }
+
+sub pp_null {
+    my $op = shift;
+    warn sprintf("Skipping null op %s\n", peekop($op)) if $debug;
+    return $op->first;
+}
+
+sub pp_const {
+    my $op = shift;
+    my $sv = $op->sv;
+    if (class($sv) eq "IV") {
+	return $sv->IV;
+    } elsif (class($sv) eq "NV") {
+	return $sv->NV;
+    } else {
+	return $sv->PV;
+    }
+}
+
+sub pp_gvsv {
+    my $op = shift;
+    my $gv = $op->gv;
+    my $stash = $gv->STASH->NAME;
+    if ($stash eq "main") {
+	$stash = "";
+    } else {
+	$stash = $stash . "::";
+    }
+    return sprintf('$%s%s', $stash, $gv->NAME);
+}
+
+1;
diff --git a/B/Lint.pm b/B/Lint.pm
new file mode 100644
index 0000000000..9b9cdd05db
--- /dev/null
+++ b/B/Lint.pm
@@ -0,0 +1,195 @@
+package B::Lint;
+
+=head1 NAME
+
+B::Lint - Perl lint
+
+=head1 SYNOPSIS
+
+perl -MO=Lint[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+The B::Lint module is equivalent to an extended version of the B<-w>
+option of B<perl>. It is named after the program B<lint> which carries
+out a similar process for C programs.
+
+=head1 OPTIONS AND LINT CHECKS
+
+Option words are separated by commas (not whitespace) and follow the
+usual conventions of compiler backend options. Following any options
+(indicated by a leading B<->) come lint check arguments. Each is a
+word representing one possible lint check (turning on that check) or
+is B<no-foo> meaning to turn off check B<foo>. By default, a standard
+list of checks is turned on. Available checks are:
+
+=over 8
+
+=item B<context>
+
+Produces a warning whenever an array is used in an implicit scalar
+context. For example, both of the lines
+
+    $foo = length(@bar);
+    $foo = @bar;
+will elicit a warning. Using an explicit B<scalar()> silences the
+warning. For example,
+
+    $foo = scalar(@bar);
+
+=item B<implicit-read> and B<implicit-write>
+
+These options produce a warning whenever an operation implicitly
+reads or (respectively) writes to one of Perl's special variables.
+For example, B<implicit-read> will warn about these:
+
+    /foo/;
+
+and B<implicit-write> will warn about these:
+
+    s/foo/bar/;
+
+=back
+
+=head1 BUGS
+
+This is only a very preliminary version.
+
+=head1 AUTHOR
+
+Malcolm Beattie, mbeattie@sable.ox.ac.uk.
+
+=cut
+
+use strict;
+use B qw(walkoptree_slow main_root parents);
+
+# Constants (should probably be elsewhere)
+sub G_ARRAY () { 1 }
+sub OPf_LIST () { 1 }
+sub OPf_KNOW () { 2 }
+sub OPf_STACKED () { 64 }
+
+my $file = "unknown";		# shadows current filename
+my $line = 0;			# shadows current line number
+
+# Lint checks
+my %check;
+my %implies_ok_context;
+BEGIN {
+    map($implies_ok_context{$_}++,
+	qw(pp_scalar pp_av2arylen pp_aelem pp_aslice pp_helem pp_hslice
+	   pp_keys pp_values pp_hslice pp_defined pp_undef pp_delete));
+}
+
+# Lint checks turned on by default
+my @default_checks = qw(context);
+
+# Debugging options
+my ($debug_op);
+
+sub warning {
+    my $format = (@_ < 2) ? "%s" : shift;
+    warn sprintf("$format at %s line %d\n", @_, $file, $line);
+}
+
+# This gimme can't cope with context that's only determined
+# at runtime via dowantarray().
+sub gimme {
+    my $op = shift;
+    my $flags = $op->flags;
+    if ($flags & OPf_KNOW) {
+	return(($flags & OPf_LIST) ? 1 : 0);
+    }
+    return undef;
+}
+
+sub B::OP::lint {}
+
+sub B::COP::lint {
+    my $op = shift;
+    if ($op->ppaddr eq "pp_nextstate") {
+	$file = $op->filegv->SV->PV;
+	$line = $op->line;
+    }
+}
+
+sub B::UNOP::lint {
+    my $op = shift;
+    my $ppaddr = $op->ppaddr;
+    if ($check{context} && ($ppaddr eq "pp_rv2av" || $ppaddr eq "pp_rv2hv")) {
+	my $parent = parents->[0];
+	my $pname = $parent->ppaddr;
+	return if gimme($op) || $implies_ok_context{$pname};
+	# Two special cases to deal with: "foreach (@foo)" and "delete $a{$b}"
+	# null out the parent so we have to check for a parent of pp_null and
+	# a grandparent of pp_enteriter or pp_delete
+	if ($pname eq "pp_null") {
+	    my $gpname = parents->[1]->ppaddr;
+	    return if $gpname eq "pp_enteriter" || $gpname eq "pp_delete";
+	}
+	warning("Implicit scalar context for %s in %s",
+		$ppaddr eq "pp_rv2av" ? "array" : "hash", $parent->desc);
+    }
+}
+
+sub B::PMOP::lint {
+    my $op = shift;
+    if ($check{implicit_read}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_match" && !($op->flags & OPf_STACKED)) {
+	    warning('Implicit match on $_');
+	}
+    }
+    elsif ($check{implicit_write}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_subst" && !($op->flags & OPf_STACKED)) {
+	    warning('Implicit substitution on $_');
+	}
+    }
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+    # Turn on default lint checks
+    for $opt (@default_checks) {
+	$check{$opt} = 1;
+    }
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		}
+	    }
+	}
+    }
+    foreach $opt (@default_checks, @options) {
+	$opt =~ tr/-/_/;
+	if ($opt =~ s/^no-//) {
+	    $check{$opt} = 0;
+	} else {
+	    $check{$opt} = 1;
+	}
+    }
+    # Remaining arguments are things to check
+    
+    return sub { walkoptree_slow(main_root, "lint") };
+}
+
+1;
diff --git a/B/Terse.pm b/B/Terse.pm
index eec2b00d79..6489dc0afe 100644
--- a/B/Terse.pm
+++ b/B/Terse.pm
@@ -1,6 +1,6 @@
 package B::Terse;
 use strict;
-use B qw(peekop class ad walkoptree walkoptree_exec
+use B qw(peekop class walkoptree_slow walkoptree_exec
 	 main_start main_root cstring svref_2object);
 use B::Asmdata qw(@specialsv_name);
 
@@ -10,7 +10,7 @@ sub terse {
     if ($order eq "exec") {
 	walkoptree_exec($cv->START, "terse");
     } else {
-	walkoptree($cv->ROOT, "terse");
+	walkoptree_slow($cv->ROOT, "terse");
     }
 }
 
@@ -30,7 +30,7 @@ sub compile {
 	if ($order eq "exec") {
 	    return sub { walkoptree_exec(main_start, "terse") }
 	} else {
-	    return sub { walkoptree(main_root, "terse") }
+	    return sub { walkoptree_slow(main_root, "terse") }
 	}
     }
 }
@@ -84,13 +84,13 @@ sub B::COP::terse {
 sub B::PV::terse {
     my ($sv, $level) = @_;
     print indent($level);
-    printf "%s (0x%lx) %s\n", class($sv), ad($sv), cstring($sv->PV);
+    printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV);
 }
 
 sub B::AV::terse {
     my ($sv, $level) = @_;
     print indent($level);
-    printf "%s (0x%lx) FILL %d\n", class($sv), ad($sv), $sv->FILL;
+    printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL;
 }
 
 sub B::GV::terse {
@@ -102,25 +102,25 @@ sub B::GV::terse {
 	$stash = $stash . "::";
     }
     print indent($level);
-    printf "%s (0x%lx) *%s%s\n", class($gv), ad($gv), $stash, $gv->NAME;
+    printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME;
 }
 
 sub B::IV::terse {
     my ($sv, $level) = @_;
     print indent($level);
-    printf "%s (0x%lx) %d\n", class($sv), ad($sv), $sv->IV;
+    printf "%s (0x%lx) %d\n", class($sv), $$sv, $sv->IV;
 }
 
 sub B::NV::terse {
     my ($sv, $level) = @_;
     print indent($level);
-    printf "%s (0x%lx) %s\n", class($sv), ad($sv), $sv->NV;
+    printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
 }
 
 sub B::NULL::terse {
     my ($sv, $level) = @_;
     print indent($level);
-    printf "%s (0x%lx)\n", class($sv), ad($sv);
+    printf "%s (0x%lx)\n", class($sv), $$sv;
 }
     
 sub B::SPECIAL::terse {
diff --git a/B/Xref.pm b/B/Xref.pm
index 8a29ba3ef9..1289b11a0c 100644
--- a/B/Xref.pm
+++ b/B/Xref.pm
@@ -85,7 +85,7 @@ Malcolm Beattie, mbeattie@sable.ox.ac.uk.
 =cut
 
 use strict;
-use B qw(peekop class ad comppadlist main_start svref_2object walksymtable);
+use B qw(peekop class comppadlist main_start svref_2object walksymtable);
 
 # Constants (should probably be elsewhere)
 sub OPpLVAL_INTRO () { 128 }
@@ -275,7 +275,7 @@ sub pp_entersub {
 sub B::GV::xref {
     my $gv = shift;
     my $cv = $gv->CV;
-    if (ad($cv)) {
+    if ($$cv) {
 	#return if $done{$$cv}++;
 	$file = $gv->FILEGV->SV->PV;
 	$line = $gv->LINE;
@@ -283,7 +283,7 @@ sub B::GV::xref {
 	push(@todo, $cv);
     }
     my $form = $gv->FORM;
-    if (ad($form)) {
+    if ($$form) {
 	return if $done{$$form}++;
 	$file = $gv->FILEGV->SV->PV;
 	$line = $gv->LINE;
diff --git a/Makefile.PL b/Makefile.PL
index 5ac4e8eb6f..7331bfd8c1 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -3,15 +3,14 @@ use Config;
 
 WriteMakefile(
     NAME	=> "B",
-    VERSION	=> "a2",
-    MAP_TARGET	=> "bperl",
+    VERSION	=> "a4",
     OBJECT	=> "B.o ccop.o byterun.o",
     depend	=> {
 	"B.o"		=> "B.c ccop.h bytecode.h byterun.h",
 	"ccop.o"	=> "ccop.c ccop.h"
     },
     clean	=> {
-	FILES		=> "bperl byteperl btest btest.c *.o B.c *~"
+	FILES		=> "perl byteperl btest btest.c *.o B.c *~"
     }
 );
 
diff --git a/README b/README
index b1bffcee88..4e4ed25fdc 100644
--- a/README
+++ b/README
@@ -1,6 +1,6 @@
-		  Perl Compiler Kit, Version alpha3
+		  Perl Compiler Kit, Version alpha4
 
-		 Copyright (c) 1996, Malcolm Beattie
+		 Copyright (c) 1996, 1997, Malcolm Beattie
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of either:
@@ -25,6 +25,14 @@
 
 CHANGES
 
+New since alpha3
+    Anonymous subs work properly with C and CC.
+    Heuristics for forcing compilation of apparently unused subs/methods.
+    Subs which use the AutoLoader module are forcibly loaded at compile-time.
+    Slightly faster compilation.
+    Handles slightly more complex code within a BEGIN { }.
+    Minor bug fixes.
+
 New since alpha2
     CC backend now supports ".." and s//e.
     Xref backend generates cross-reference reports
@@ -38,7 +46,7 @@ New since alpha1
 
 INSTALLATION
 
-(1) You need perl5.002 or perl5.003.
+(1) You need perl5.002 or later.
 
 (2) If you want to compile and run programs with the C or CC backends
 which undefine (or redefine) subroutines, then you need to apply a
@@ -61,14 +69,14 @@ I haven't tested this option yet with an old pre-Standard compiler.
 (4) If your platform supports dynamic loading then just type
     make
 and you can then use
-    perl -Iblib/arch -MO=foo bar baz
+    perl -Iblib/arch -MO=foo bar
 to use the compiler modules (see later for details).
 If you need/want instead to make a statically linked perl which
 contains the appropriate modules, then type
-    make bperl
+    make perl
     make byteperl
 and you can then use
-    ./bperl -MO=foo bar baz
+    ./perl -MO=foo bar
 to use the compiler modules.    
 In both cases, the byteperl executable is required for running standalone
 bytecode programs. It is *not* a standard perl+XSUB perl executable.
@@ -84,7 +92,7 @@ In the following examples, you'll need to replace "perl" by
 if you have built the extensions for a dynamic loading platform but
 haven't installed the extensions completely. You'll need to replace
 "perl" by
-    ./bperl
+    ./perl
 if you have built the extensions into a statically linked perl binary.
 
 (1) To compile perl program foo.pl with the C backend, do
@@ -149,7 +157,7 @@ it. For example, with Digital UNIX, do something like
     ld -shared -o libperl.so -all libperl.a -none -lc
 and with Linux/ELF, rebuild the perl .c files with -fPIC (and I
 also suggest -fomit-frame-pointer for Linux on Intel architetcures),
-do "Make libperl.a" and then do
+do "make libperl.a" and then do
     gcc -shared -Wl,-soname,libperl.so.5 -o libperl.so.5.3 `ar t libperl.a`
 and then
     # cp libperl.so.5.3 /usr/lib
diff --git a/TESTS b/TESTS
index bf5d20dc71..e050f6cfdd 100644
--- a/TESTS
+++ b/TESTS
@@ -1,78 +1,78 @@
 Test results from compiling t/*/*.t
 		C		Bytecode	CC
 
-base/cond.t	OK		OK		OK
-base/if.t	OK		OK		OK
-base/lex.t	OK		OK		OK
-base/pat.t	OK		OK		OK
-base/term.t	OK		OK		OK
-cmd/elsif.t	OK		OK		OK
-cmd/for.t	OK		OK		OK
-cmd/mod.t	OK		OK		OK
-cmd/subval.t	OK		OK		1..34, not ok 27,28 (simply
+base/cond.t	OK		ok		OK
+base/if.t	OK		ok		OK
+base/lex.t	OK		ok		OK
+base/pat.t	OK		ok		OK
+base/term.t	OK		ok		OK
+cmd/elsif.t	OK		ok		OK
+cmd/for.t	OK		ok		ok 1, 2, 3, panic: pp_iter
+cmd/mod.t	OK		ok		ok
+cmd/subval.t	OK		ok		1..34, not ok 27,28 (simply
 						because filename changes).
-cmd/switch.t	OK		OK		OK
-cmd/while.t	OK		OK		OK
-io/argv.t	OK		OK		OK
-io/dup.t	OK		OK		OK
-io/fs.t		OK		OK		OK
-io/inplace.t	OK		OK		OK
-io/pipe.t	OK with -umain	OK		OK with -umain
-io/print.t	OK		OK		OK
-io/tell.t	OK		OK		OK
-op/append.t	OK		OK		OK
-op/array.t	OK		OK		1..36, not ok 7,10 (no $[)
-op/auto.t	OK		OK		OK
-op/chop.t	OK		OK		OK
-op/cond.t	OK		OK		OK
-op/delete.t	OK		OK		OK
-op/do.t		OK		OK		OK
-op/each.t	OK		OK		OK
-op/eval.t	OK		OK		OK
-op/exec.t	OK		OK		OK
-op/exp.t	OK		OK		OK
-op/flip.t	OK		OK		OK
-op/fork.t	OK		OK		OK
-op/glob.t	OK		OK		OK
-op/goto.t	OK		OK		1..9, Can't find label label1.
+cmd/switch.t	OK		ok		ok
+cmd/while.t	OK		ok		ok
+io/argv.t	OK		ok		ok
+io/dup.t	OK		ok		ok
+io/fs.t		OK		ok		ok
+io/inplace.t	OK		ok		ok
+io/pipe.t	OK		ok		ok with -umain
+io/print.t	OK		ok		ok
+io/tell.t	OK		ok		ok
+op/append.t	OK		ok		OK
+op/array.t	OK		ok		1..36, not ok 7,10 (no $[)
+op/auto.t	OK		ok		OK
+op/chop.t	OK		ok		OK
+op/cond.t	OK		ok		OK
+op/delete.t	OK		ok		OK
+op/do.t		OK		ok		OK
+op/each.t	OK		ok		OK
+op/eval.t	OK		ok		ok 1-6 of 16 then exits
+op/exec.t	OK		ok		OK
+op/exp.t	OK		ok		OK
+op/flip.t	OK		ok		OK
+op/fork.t	OK		ok		OK
+op/glob.t	OK		ok		OK
+op/goto.t	OK		ok		1..9, Can't find label label1.
 op/groups.t	OK (s/ucb/bin/ under Linux)	OK 1..0 for now.
-op/index.t	OK		OK		OK
-op/int.t	OK		OK		OK
-op/join.t	OK		OK		OK
-op/list.t	OK		OK		OK
-op/local.t	OK		OK		OK
-op/magic.t	OK		OK		OK with -umain
+op/index.t	OK		ok		OK
+op/int.t	OK		ok		OK
+op/join.t	OK		ok		OK
+op/list.t	OK		ok		OK
+op/local.t	OK		ok		OK
+op/magic.t	OK		ok		OK
 op/misc.t	no DATA filehandle so succeeds trivially with 1..0
-op/mkdir.t	OK		OK		OK
-op/my.t		OK		OK		OK
-op/oct.t	OK		OK		OK (C large const warnings)
-op/ord.t	OK		OK		OK
+op/mkdir.t	OK		ok		OK
+op/my.t		OK		ok		OK
+op/oct.t	OK		ok		OK (C large const warnings)
+op/ord.t	OK		ok		OK
 op/overload.t	Mostly not ok	Mostly not ok	C errors.
-op/pack.t	OK		OK		OK
-op/pat.t	OK		OK		OK
-op/push.t	OK		OK		OK
-op/quotemeta.t	OK		OK		OK
-op/rand.t	OK		OK		OK
-op/range.t	OK		OK		OK
-op/read.t	OK		OK		OK
-op/readdir.t	OK		OK		OK
-op/ref.t	omits "ok 40" (lex destruction)	OK (Bytecode)
+op/pack.t	OK		ok		OK
+op/pat.t	omit 26 (reset)	ok		[lots of memory for compile]
+op/push.t	OK		ok		OK
+op/quotemeta.t	OK		ok		OK
+op/rand.t	OK		ok		
+op/range.t	OK		ok		OK
+op/read.t	OK		ok		OK
+op/readdir.t	OK		ok		OK (substcont works too)
+op/ref.t	omits "ok 40" (lex destruction)	ok (Bytecode)
 						CC: need -u for OBJ,BASEOBJ,
-						MYHASH,UNIVERSAL,WHATEVER,main
-						FINALE. 1..41, ok1-33,36-38,
+						UNIVERSAL,WHATEVER,main.
+						1..41, ok1-33,36-38,
 						then ok 41, ok 39.DESTROY probs
-op/regexp.t	OK		OK		OK (trivially all eval'd)
-op/repeat.t	OK		OK		OK
-op/sleep.t	OK		OK		OK
-op/sort.t	OK		OK		1..10, ok 1, Out of memory!
-op/split.t	OK		OK		OK
-op/sprintf.t	OK		OK		OK
-op/stat.t	OK		OK		OK
-op/study.t	OK		OK		OK
-op/subst.t	OK		OK		OK
-op/substr.t	OK		OK		ok1-22 except 7-9,11 (all $[)
-op/time.t	OK		OK		OK
-op/undef.t	OK		OK		OK
-op/unshift.t	OK		OK		OK
-op/vec.t	OK		OK		OK
+op/regexp.t	OK		ok		ok (trivially all eval'd)
+op/repeat.t	OK		ok		ok
+op/sleep.t	OK		ok		ok
+op/sort.t	OK		ok		1..10, ok 1, Out of memory!
+op/split.t	OK		ok		ok
+op/sprintf.t	OK		ok		ok
+op/stat.t	OK		ok		ok
+op/study.t	OK		ok		ok
+op/subst.t	OK		ok		ok
+op/substr.t	OK		ok		ok1-22 except 7-9,11 (all $[)
+op/time.t	OK		ok		ok
+op/undef.t	omit 21		ok		ok
+op/unshift.t	OK		ok		ok
+op/vec.t	OK		ok		ok
 op/write.t	not ok 3 (no CvOUTSIDE lex from runtime eval). CC: 1..3, hang
diff --git a/assemble b/assemble
index 491210e893..3ad14f7d96 100755
--- a/assemble
+++ b/assemble
@@ -1,4 +1,3 @@
-#!./bperl
 use B::Assembler qw(assemble_fh);
 use FileHandle;
 
diff --git a/bytecode.pl b/bytecode.pl
index 359110da16..0f79e6589a 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -283,19 +283,19 @@ xio_page	IoPAGE(sv)		long
 xio_page_len	IoPAGE_LEN(sv)		long
 xio_lines_left	IoLINES_LEFT(sv)	long
 xio_top_name	IoTOP_NAME(sv)		pvcontents
-xio_top_gv	IoTOP_GV(sv)		svindex
+xio_top_gv	*(SV**)&IoTOP_GV(sv)	svindex
 xio_fmt_name	IoFMT_NAME(sv)		pvcontents
-xio_fmt_gv	IoFMT_GV(sv)		svindex
+xio_fmt_gv	*(SV**)&IoFMT_GV(sv)	svindex
 xio_bottom_name	IoBOTTOM_NAME(sv)	pvcontents
-xio_bottom_gv	IoBOTTOM_GV(sv)		svindex
+xio_bottom_gv	*(SV**)&IoBOTTOM_GV(sv)	svindex
 xio_subprocess	IoSUBPROCESS(sv)	short
 xio_type	IoTYPE(sv)		char
 xio_flags	IoFLAGS(sv)		char
 xcv_stash	*(SV**)&CvSTASH(sv)	svindex
 xcv_start	CvSTART(sv)		opindex
 xcv_root	CvROOT(sv)		opindex
-xcv_gv		CvGV(sv)		svindex
-xcv_filegv	CvFILEGV(sv)		svindex
+xcv_gv		*(SV**)&CvGV(sv)	svindex
+xcv_filegv	*(SV**)&CvFILEGV(sv)	svindex
 xcv_depth	CvDEPTH(sv)		long
 xcv_padlist	*(SV**)&CvPADLIST(sv)	svindex
 xcv_outside	*(SV**)&CvOUTSIDE(sv)	svindex
@@ -353,7 +353,7 @@ op_pmflags	cPMOP->op_pmflags	U16
 op_pmpermflags	cPMOP->op_pmpermflags	U16
 op_pmslen	cPMOP->op_pmslen	char
 op_sv		cSVOP->op_sv		svindex
-op_gv		cGVOP->op_gv		svindex
+op_gv		*(SV**)&cGVOP->op_gv	svindex
 op_pv		cPVOP->op_pv		pvcontents
 op_pv_tr	cPVOP->op_pv		op_tr_array
 op_redoop	cLOOP->op_redoop	opindex
@@ -361,7 +361,7 @@ op_nextop	cLOOP->op_nextop	opindex
 op_lastop	cLOOP->op_lastop	opindex
 cop_label	cCOP->cop_label		pvcontents
 cop_stash	*(SV**)&cCOP->cop_stash		svindex
-cop_filegv	cCOP->cop_filegv	svindex
+cop_filegv	*(SV**)&cCOP->cop_filegv	svindex
 cop_seq		cCOP->cop_seq		U32
 cop_arybase	cCOP->cop_arybase	I32
 cop_line	cCOP->cop_line		line_t
diff --git a/byteperl.c b/byteperl.c
index e81a45b11e..c40e0d3f37 100644
--- a/byteperl.c
+++ b/byteperl.c
@@ -4,6 +4,9 @@ extern "C" {
 
 #include "EXTERN.h"
 #include "perl.h"
+#ifndef PATCHLEVEL
+#include "patchlevel.h"
+#endif
 #include "byterun.h"
 
 #ifdef __cplusplus
diff --git a/byterun.c b/byterun.c
index 1ff323915b..7eb981e4bd 100644
--- a/byterun.c
+++ b/byterun.c
@@ -271,7 +271,7 @@ FILE *fp;
 	    {
 		svindex arg;
 		BGET_objindex(arg);
-		IoTOP_GV(sv) = arg;
+		*(SV**)&IoTOP_GV(sv) = arg;
 		break;
 	    }
 	  case INSN_XIO_FMT_NAME:		/* 37 */
@@ -285,7 +285,7 @@ FILE *fp;
 	    {
 		svindex arg;
 		BGET_objindex(arg);
-		IoFMT_GV(sv) = arg;
+		*(SV**)&IoFMT_GV(sv) = arg;
 		break;
 	    }
 	  case INSN_XIO_BOTTOM_NAME:		/* 39 */
@@ -299,7 +299,7 @@ FILE *fp;
 	    {
 		svindex arg;
 		BGET_objindex(arg);
-		IoBOTTOM_GV(sv) = arg;
+		*(SV**)&IoBOTTOM_GV(sv) = arg;
 		break;
 	    }
 	  case INSN_XIO_SUBPROCESS:		/* 41 */
@@ -348,14 +348,14 @@ FILE *fp;
 	    {
 		svindex arg;
 		BGET_objindex(arg);
-		CvGV(sv) = arg;
+		*(SV**)&CvGV(sv) = arg;
 		break;
 	    }
 	  case INSN_XCV_FILEGV:		/* 48 */
 	    {
 		svindex arg;
 		BGET_objindex(arg);
-		CvFILEGV(sv) = arg;
+		*(SV**)&CvFILEGV(sv) = arg;
 		break;
 	    }
 	  case INSN_XCV_DEPTH:		/* 49 */
@@ -761,7 +761,7 @@ FILE *fp;
 	    {
 		svindex arg;
 		BGET_objindex(arg);
-		cGVOP->op_gv = arg;
+		*(SV**)&cGVOP->op_gv = arg;
 		break;
 	    }
 	  case INSN_OP_PV:		/* 107 */
@@ -817,7 +817,7 @@ FILE *fp;
 	    {
 		svindex arg;
 		BGET_objindex(arg);
-		cCOP->cop_filegv = arg;
+		*(SV**)&cCOP->cop_filegv = arg;
 		break;
 	    }
 	  case INSN_COP_SEQ:		/* 115 */
diff --git a/cc_runtime.h b/cc_runtime.h
index b7658a936f..475af3bb9b 100644
--- a/cc_runtime.h
+++ b/cc_runtime.h
@@ -35,7 +35,6 @@
 	SPAGAIN;		\
     } while(0)
 
-#include "patchlevel.h"
 #if PATCHLEVEL < 3
 #define RUN() run()
 #else
diff --git a/disassemble b/disassemble
index 12483f776d..6530b80950 100755
--- a/disassemble
+++ b/disassemble
@@ -1,4 +1,3 @@
-#!./bperl
 use B::Disassembler qw(disassemble_fh);
 use FileHandle;
 
diff --git a/makeliblinks b/makeliblinks
new file mode 100644
index 0000000000..82560783c0
--- /dev/null
+++ b/makeliblinks
@@ -0,0 +1,54 @@
+use File::Find;
+use Config;
+
+if (@ARGV != 2) {
+    warn <<"EOT";
+Usage: makeliblinks libautodir targetdir
+where libautodir is the architecture-dependent auto directory
+(e.g. $Config::Config{archlib}/auto).
+EOT
+    exit 2;
+}
+
+my ($libautodir, $targetdir) = @ARGV;
+
+# Calculate relative path prefix from $targetdir to $libautodir
+sub relprefix {
+    my ($to, $from) = @_;
+    my $up;
+    for ($up = 0; substr($to, 0, length($from)) ne $from; $up++) {
+	$from =~ s(
+		   [^/]+	(?# a group of non-slashes) 
+		   /*		(?# maybe with some trailing slashes)
+		   $		(?# at the end of the path)
+                  )()x;
+    }
+    return (("../" x $up) . substr($to, length($from)));
+}
+
+my $relprefix = relprefix($libautodir, $targetdir);
+
+my ($dlext, $lib_ext) = @Config::Config{qw(dlext lib_ext)};
+
+sub link_if_library {
+    if (/\.($dlext|$lib_ext)$/o) {
+	my $ext = $1;
+	my $name = $File::Find::name;
+	if (substr($name, 0, length($libautodir) + 1) ne "$libautodir/") {
+	    die "directory of $name doesn't match $libautodir\n";
+	}
+	substr($name, 0, length($libautodir) + 1) = '';
+	my @parts = split(m(/), $name);
+	if ($parts[-1] ne "$parts[-2].$ext") {
+	    die "module name $_ doesn't match its directory $libautodir\n";
+	}
+	pop @parts;
+	my $libpath = "$targetdir/lib" . join("__", @parts) . ".$ext";
+	print "$libpath -> $relprefix/$name\n";
+	symlink("$relprefix/$name", $libpath)
+	    or warn "above link failed with error: $!\n";
+    }
+}
+
+find(\&link_if_library, $libautodir);
+exit 0;
diff --git a/test_harness b/test_harness
index f930c351ee..048fdc947e 100755
--- a/test_harness
+++ b/test_harness
@@ -1,4 +1,5 @@
 #!/bin/sh
+cwd=`pwd`
 if [ -f bperl ]; then
     perl=./bperl
 else
@@ -10,5 +11,5 @@ do
     $perl -MO=C,-obtest.tc $pl			\
 	&& mv btest.tc btest.c			\
 	&& $perl cc_harness -o btest btest.c	\
-	&& ./btest
+	&& (cd t; $cwd/btest)
 done
diff --git a/test_harness_cc b/test_harness_cc
index da58b78d3a..01157a5307 100755
--- a/test_harness_cc
+++ b/test_harness_cc
@@ -1,4 +1,5 @@
 #!/bin/sh
+cwd=`pwd`
 if [ -f bperl ]; then
     perl=./bperl
 else
@@ -10,5 +11,5 @@ do
     $perl -MO=CC,-obtest.tc $pl			\
 	&& mv btest.tc btest.c			\
 	&& $perl cc_harness -O2 -o btest btest.c\
-	&& ./btest
+	&& (cd t; $cwd/btest)
 done