From: Nicholas Clark Date: Mon, 15 Jan 2007 18:15:54 +0000 (+0000) Subject: pp_rv2av and pp_rv2hv have a lot of common code, so it's certainly a X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=17ab79462074d95168fb4cd137197d4e6a0696b2;p=p5sagit%2Fp5-mst-13.2.git 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 --- diff --git a/mathoms.c b/mathoms.c index 19c4979..7d6f142 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 f2a898f..0c5eb30 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 09b1635..1c8245c 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 429ae2c..1f0820a 100644 --- a/pp.h +++ b/pp.h @@ -403,7 +403,7 @@ and C. 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. 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. } 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 e08ff7c..5dd8104 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; }