Change 30194 by [EMAIL PROTECTED] on 2007/02/10 18:07:51
Integrate:
[ 29835]
Make changes analagous to pp_rv2hv's 21394 and 24489 in pp_rv2av.
[ 29836]
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.
Affected files ...
... //depot/maint-5.8/perl/mathoms.c#29 integrate
... //depot/maint-5.8/perl/opcode.h#25 integrate
... //depot/maint-5.8/perl/opcode.pl#32 integrate
... //depot/maint-5.8/perl/pp.h#21 integrate
... //depot/maint-5.8/perl/pp_hot.c#129 edit
Differences ...
==== //depot/maint-5.8/perl/mathoms.c#29 (text) ====
Index: perl/mathoms.c
--- perl/mathoms.c#28~30181~ 2007-02-09 09:20:56.000000000 -0800
+++ perl/mathoms.c 2007-02-10 10:07:51.000000000 -0800
@@ -1113,6 +1113,11 @@
return pp_bit_or();
}
+PP(pp_rv2hv)
+{
+ return Perl_pp_rv2av(aTHX);
+}
+
U8 *
Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
{
==== //depot/maint-5.8/perl/opcode.h#25 (text+w) ====
Index: perl/opcode.h
--- perl/opcode.h#24~30036~ 2007-01-27 09:35:47.000000000 -0800
+++ perl/opcode.h 2007-02-10 10:07:51.000000000 -0800
@@ -890,7 +890,7 @@
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),
==== //depot/maint-5.8/perl/opcode.pl#32 (xtext) ====
Index: perl/opcode.pl
--- perl/opcode.pl#31~30036~ 2007-01-27 09:35:47.000000000 -0800
+++ perl/opcode.pl 2007-02-10 10:07:51.000000000 -0800
@@ -82,6 +82,7 @@
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) {
==== //depot/maint-5.8/perl/pp.h#21 (text) ====
Index: perl/pp.h
--- perl/pp.h#20~29859~ 2007-01-17 14:07:40.000000000 -0800
+++ perl/pp.h 2007-02-10 10:07:51.000000000 -0800
@@ -415,7 +415,7 @@
if ((SvAMAGIC(left)||SvAMAGIC(right))) {\
SV * const tmpsv = amagic_call(left, \
right, \
- meth_enum, \
+ (meth_enum), \
(assign)? AMGf_assign: 0); \
if (tmpsv) { \
SPAGAIN; \
@@ -451,7 +451,7 @@
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; } \
} \
@@ -481,6 +481,8 @@
} 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 { \
==== //depot/maint-5.8/perl/pp_hot.c#129 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#128~30166~ 2007-02-07 14:59:15.000000000 -0800
+++ perl/pp_hot.c 2007-02-10 10:07:51.000000000 -0800
@@ -722,23 +722,30 @@
PP(pp_rv2av)
{
dSP; dTOPss;
- AV *av;
+ const I32 gimme = GIMME_V;
+ 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 && SvTYPE(sv) != SVt_PVAV)
+ 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_SCALAR)
- Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
- SETs((SV*)av);
+ if (gimme != G_ARRAY)
+ 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
@@ -746,17 +753,17 @@
Perl_croak(aTHX_ PL_no_localize_ref);
}
else {
- if (SvTYPE(sv) == SVt_PVAV) {
- av = (AV*)sv;
+ if (SvTYPE(sv) == type || SvTYPE(sv) == SVt_PVAV) {
if (PL_op->op_flags & OPf_REF) {
- SETs((SV*)av);
+ SETs(sv);
RETURN;
}
else if (LVRET) {
- if (GIMME == G_SCALAR)
- Perl_croak(aTHX_ "Can't return array to lvalue"
- " scalar context");
- SETs((SV*)av);
+ if (gimme != G_ARRAY)
+ Perl_croak(aTHX_
+ is_pp_rv2av ? return_array_to_lvalue_scalar
+ : return_hash_to_lvalue_scalar);
+ SETs(sv);
RETURN;
}
}
@@ -772,11 +779,11 @@
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();
- if (GIMME == G_ARRAY) {
- (void)POPs;
+ if (gimme == G_ARRAY) {
+ SP--;
RETURN;
}
RETSETUNDEF;
@@ -784,41 +791,48 @@
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_SCALAR)
- Perl_croak(aTHX_ "Can't return array to lvalue"
- " scalar context");
- SETs((SV*)av);
+ if (gimme != G_ARRAY)
+ Perl_croak(aTHX_
+ is_pp_rv2av ? return_array_to_lvalue_scalar
+ : return_hash_to_lvalue_scalar);
+ SETs(sv);
RETURN;
}
}
}
- if (GIMME == G_ARRAY) {
+ 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? */
EXTEND(SP, maxarg);
@@ -837,126 +851,27 @@
}
SP += maxarg;
}
- else if (GIMME_V == G_SCALAR) {
+ else if (gimme == G_SCALAR) {
dTARGET;
const I32 maxarg = AvFILL(av) + 1;
SETi(maxarg);
}
- RETURN;
-}
-
-PP(pp_rv2hv)
-{
- 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 && SvTYPE(hv) != SVt_PVAV)
- 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 || SvTYPE(sv) == SVt_PVAV) {
- 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();
- 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;
- if (SvTYPE(hv) == SVt_PVAV)
- hv = avhv_keys((AV*)hv);
+ if (SvTYPE(sv) == SVt_PVAV)
+ sv = (SV*)avhv_keys((AV*)sv);
- TARG = Perl_hv_scalar(aTHX_ hv);
+ TARG = Perl_hv_scalar(aTHX_ (HV *)sv);
SETTARG;
}
+ }
RETURN;
}
End of Patch.
