pp_rv2av and pp_rv2hv have a lot of common code, so it's certainly a

space saving to merge them. Hopefully this will reduce L2 cache misses.

p4raw-id: //depot/perl@29836

5 files changed, 54 insertions, 131 deletions

diff --git a/mathoms.c b/mathoms.c
index 19c4979384..7d6f142c07 100644
--- a/mathoms.c
+++ b/mathoms.c
@@ -1117,6 +1117,11 @@ PP(pp_bit_xor)
     return pp_bit_or();
 }
 
+PP(pp_rv2hv)
+{
+    return Perl_pp_rv2av(aTHX);
+}
+
 U8 *
 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
 {
diff --git a/opcode.h b/opcode.h
index f2a898fd6a..0c5eb30e8c 100644
--- a/opcode.h
+++ b/opcode.h
@@ -917,7 +917,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
 	MEMBER_TO_FPTR(Perl_do_kv),	/* Perl_pp_keys */
 	MEMBER_TO_FPTR(Perl_pp_delete),
 	MEMBER_TO_FPTR(Perl_pp_exists),
-	MEMBER_TO_FPTR(Perl_pp_rv2hv),
+	MEMBER_TO_FPTR(Perl_pp_rv2av),	/* Perl_pp_rv2hv */
 	MEMBER_TO_FPTR(Perl_pp_helem),
 	MEMBER_TO_FPTR(Perl_pp_hslice),
 	MEMBER_TO_FPTR(Perl_pp_unpack),
diff --git a/opcode.pl b/opcode.pl
index 09b1635961..1c8245c92c 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -90,6 +90,7 @@ my @raw_alias = (
 		 Perl_pp_shift => ['pop'],
 		 Perl_pp_sin => [qw(cos exp log sqrt)],
 		 Perl_pp_bit_or => ['bit_xor'],
+		 Perl_pp_rv2av => ['rv2hv'],
 		);
 
 while (my ($func, $names) = splice @raw_alias, 0, 2) {
diff --git a/pp.h b/pp.h
index 429ae2cb18..1f0820a339 100644
--- a/pp.h
+++ b/pp.h
@@ -403,7 +403,7 @@ and C<PUSHu>.
 	    if ((SvAMAGIC(left)||SvAMAGIC(right))) {\
 		SV * const tmpsv = amagic_call(left, \
 				   right, \
-				   meth_enum, \
+				   (meth_enum), \
 				   (assign)? AMGf_assign: 0); \
 		if (tmpsv) { \
 		    SPAGAIN; \
@@ -437,7 +437,7 @@ and C<PUSHu>.
           if(0) goto am_again;  /* shut up unused warning */ \
 	  am_again: \
 	    if ((SvAMAGIC(arg))&&\
-		(tmpsv=AMG_CALLun_var(arg,meth_enum))) {\
+		(tmpsv=AMG_CALLun_var(arg,(meth_enum)))) {\
 	       SPAGAIN; if (shift) sp += shift; \
 	       set(tmpsv); ret; } \
 	} STMT_END
@@ -466,6 +466,8 @@ and C<PUSHu>.
     } STMT_END
 
 #define tryAMAGICunDEREF(meth) tryAMAGICunW(meth,setAGAIN,0,(void)0)
+#define tryAMAGICunDEREF_var(meth_enum) \
+	tryAMAGICunW_var(meth_enum,setAGAIN,0,(void)0)
 
 #define opASSIGN (PL_op->op_flags & OPf_STACKED)
 #define SETsv(sv)	STMT_START {					\
diff --git a/pp_hot.c b/pp_hot.c
index e08ff7c0f7..5dd8104849 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -782,25 +782,30 @@ PP(pp_print)
 PP(pp_rv2av)
 {
     dVAR; dSP; dTOPss;
-    AV *av;
     const I32 gimme = GIMME_V;
-    static const char return_array_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context";
+    static const char return_array_to_lvalue_scalar[] = "Can't return array to lvalue scalar context";
+    static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context";
+    static const char an_array[] = "an ARRAY";
+    static const char a_hash[] = "a HASH";
+    const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV;
+    const U32 type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;
 
     if (SvROK(sv)) {
       wasref:
-	tryAMAGICunDEREF(to_av);
+	tryAMAGICunDEREF_var(is_pp_rv2av ? to_av_amg : to_hv_amg);
 
-	av = (AV*)SvRV(sv);
-	if (SvTYPE(av) != SVt_PVAV)
-	    DIE(aTHX_ "Not an ARRAY reference");
+	sv = SvRV(sv);
+	if (SvTYPE(sv) != type)
+	    DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
 	if (PL_op->op_flags & OPf_REF) {
-	    SETs((SV*)av);
+	    SETs(sv);
 	    RETURN;
 	}
 	else if (LVRET) {
 	    if (gimme != G_ARRAY)
-		Perl_croak(aTHX_ return_array_to_lvalue_scalar);
-	    SETs((SV*)av);
+		Perl_croak(aTHX_ is_pp_rv2av ? return_array_to_lvalue_scalar
+			   : return_hash_to_lvalue_scalar);
+	    SETs(sv);
 	    RETURN;
 	}
 	else if (PL_op->op_flags & OPf_MOD
@@ -808,16 +813,17 @@ PP(pp_rv2av)
 	    Perl_croak(aTHX_ PL_no_localize_ref);
     }
     else {
-	if (SvTYPE(sv) == SVt_PVAV) {
-	    av = (AV*)sv;
+	if (SvTYPE(sv) == type) {
 	    if (PL_op->op_flags & OPf_REF) {
-		SETs((SV*)av);
+		SETs(sv);
 		RETURN;
 	    }
 	    else if (LVRET) {
 		if (gimme != G_ARRAY)
-		    Perl_croak(aTHX_ return_array_to_lvalue_scalar);
-		SETs((SV*)av);
+		    Perl_croak(aTHX_
+			       is_pp_rv2av ? return_array_to_lvalue_scalar
+			       : return_hash_to_lvalue_scalar);
+		SETs(sv);
 		RETURN;
 	    }
 	}
@@ -833,7 +839,7 @@ PP(pp_rv2av)
 		if (!SvOK(sv)) {
 		    if (PL_op->op_flags & OPf_REF ||
 		      PL_op->op_private & HINT_STRICT_REFS)
-			DIE(aTHX_ PL_no_usym, "an ARRAY");
+			DIE(aTHX_ PL_no_usym, is_pp_rv2av ? an_array : a_hash);
 		    if (ckWARN(WARN_UNINITIALIZED))
 			report_uninit(sv);
 		    if (gimme == G_ARRAY) {
@@ -845,39 +851,47 @@ PP(pp_rv2av)
 		if ((PL_op->op_flags & OPf_SPECIAL) &&
 		    !(PL_op->op_flags & OPf_MOD))
 		{
-		    gv = (GV*)gv_fetchsv(sv, 0, SVt_PVAV);
+		    gv = (GV*)gv_fetchsv(sv, 0, type);
 		    if (!gv
 			&& (!is_gv_magical_sv(sv,0)
-			    || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVAV))))
+			    || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, type))))
 		    {
 			RETSETUNDEF;
 		    }
 		}
 		else {
 		    if (PL_op->op_private & HINT_STRICT_REFS)
-			DIE(aTHX_ PL_no_symref_sv, sv, "an ARRAY");
-		    gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVAV);
+			DIE(aTHX_ PL_no_symref_sv, sv,
+			    is_pp_rv2av ? an_array : a_hash);
+		    gv = (GV*)gv_fetchsv(sv, GV_ADD, type);
 		}
 	    }
 	    else {
 		gv = (GV*)sv;
 	    }
-	    av = GvAVn(gv);
+	    sv = is_pp_rv2av ? (SV*)GvAVn(gv) : (SV*)GvHVn(gv);
 	    if (PL_op->op_private & OPpLVAL_INTRO)
-		av = save_ary(gv);
+		sv = is_pp_rv2av ? (SV*)save_ary(gv) : (SV*)save_hash(gv);
 	    if (PL_op->op_flags & OPf_REF) {
-		SETs((SV*)av);
+		SETs(sv);
 		RETURN;
 	    }
 	    else if (LVRET) {
 		if (gimme != G_ARRAY)
-		    Perl_croak(aTHX_ return_array_to_lvalue_scalar);
-		SETs((SV*)av);
+		    Perl_croak(aTHX_
+			       is_pp_rv2av ? return_array_to_lvalue_scalar
+			       : return_hash_to_lvalue_scalar);
+		SETs(sv);
 		RETURN;
 	    }
 	}
     }
 
+    if (is_pp_rv2av) {
+	AV *const av = (AV*)sv;
+	/* The guts of pp_rv2av, with no intenting change to preserve history
+	   (until such time as we get tools that can do blame annotation across
+	   whitespace changes.  */
     if (gimme == G_ARRAY) {
 	const I32 maxarg = AvFILL(av) + 1;
 	(void)POPs;			/* XXXX May be optimized away? */
@@ -902,117 +916,18 @@ PP(pp_rv2av)
 	const I32 maxarg = AvFILL(av) + 1;
 	SETi(maxarg);
     }
-    RETURN;
-}
-
-PP(pp_rv2hv)
-{
-    dVAR; dSP; dTOPss;
-    HV *hv;
-    const I32 gimme = GIMME_V;
-    static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context";
-
-    if (SvROK(sv)) {
-      wasref:
-	tryAMAGICunDEREF(to_hv);
-
-	hv = (HV*)SvRV(sv);
-	if (SvTYPE(hv) != SVt_PVHV)
-	    DIE(aTHX_ "Not a HASH reference");
-	if (PL_op->op_flags & OPf_REF) {
-	    SETs((SV*)hv);
-	    RETURN;
-	}
-	else if (LVRET) {
-	    if (gimme != G_ARRAY)
-		Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
-	    SETs((SV*)hv);
-	    RETURN;
-	}
-	else if (PL_op->op_flags & OPf_MOD
-		&& PL_op->op_private & OPpLVAL_INTRO)
-	    Perl_croak(aTHX_ PL_no_localize_ref);
-    }
-    else {
-	if (SvTYPE(sv) == SVt_PVHV) {
-	    hv = (HV*)sv;
-	    if (PL_op->op_flags & OPf_REF) {
-		SETs((SV*)hv);
-		RETURN;
-	    }
-	    else if (LVRET) {
-		if (gimme != G_ARRAY)
-		    Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
-		SETs((SV*)hv);
-		RETURN;
-	    }
-	}
-	else {
-	    GV *gv;
-	
-	    if (SvTYPE(sv) != SVt_PVGV) {
-		if (SvGMAGICAL(sv)) {
-		    mg_get(sv);
-		    if (SvROK(sv))
-			goto wasref;
-		}
-		if (!SvOK(sv)) {
-		    if (PL_op->op_flags & OPf_REF ||
-		      PL_op->op_private & HINT_STRICT_REFS)
-			DIE(aTHX_ PL_no_usym, "a HASH");
-		    if (ckWARN(WARN_UNINITIALIZED))
-			report_uninit(sv);
-		    if (gimme == G_ARRAY) {
-			SP--;
-			RETURN;
-		    }
-		    RETSETUNDEF;
-		}
-		if ((PL_op->op_flags & OPf_SPECIAL) &&
-		    !(PL_op->op_flags & OPf_MOD))
-		{
-		    gv = (GV*)gv_fetchsv(sv, 0, SVt_PVHV);
-		    if (!gv
-			&& (!is_gv_magical_sv(sv,0)
-			    || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVHV))))
-		    {
-			RETSETUNDEF;
-		    }
-		}
-		else {
-		    if (PL_op->op_private & HINT_STRICT_REFS)
-			DIE(aTHX_ PL_no_symref_sv, sv, "a HASH");
-		    gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVHV);
-		}
-	    }
-	    else {
-		gv = (GV*)sv;
-	    }
-	    hv = GvHVn(gv);
-	    if (PL_op->op_private & OPpLVAL_INTRO)
-		hv = save_hash(gv);
-	    if (PL_op->op_flags & OPf_REF) {
-		SETs((SV*)hv);
-		RETURN;
-	    }
-	    else if (LVRET) {
-		if (gimme != G_ARRAY)
-		    Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
-		SETs((SV*)hv);
-		RETURN;
-	    }
-	}
-    }
-
+    } else {
+	/* The guts of pp_rv2hv  */
     if (gimme == G_ARRAY) { /* array wanted */
-	*PL_stack_sp = (SV*)hv;
+	*PL_stack_sp = sv;
 	return do_kv();
     }
     else if (gimme == G_SCALAR) {
 	dTARGET;
-    TARG = Perl_hv_scalar(aTHX_ hv);
+    TARG = Perl_hv_scalar(aTHX_ (HV*)sv);
 	SETTARG;
     }
+    }
     RETURN;
 }