Change 29905 by [EMAIL PROTECTED] on 2007/01/21 11:44:16
Refactor the common soft-reference code from pp_rv2sv and pp_rv2av
into a single routine Perl_softref2xv(). As soft references are
rarely used compared with true references, move this code from pp_hot.c
Affected files ...
... //depot/perl/embed.fnc#454 edit
... //depot/perl/embed.h#659 edit
... //depot/perl/pp.c#577 edit
... //depot/perl/pp_hot.c#501 edit
... //depot/perl/proto.h#792 edit
Differences ...
==== //depot/perl/embed.fnc#454 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#453~29884~ 2007-01-19 11:27:59.000000000 -0800
+++ perl/embed.fnc 2007-01-21 03:44:16.000000000 -0800
@@ -1240,6 +1240,10 @@
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
sR |SV* |refto |NN SV* sv
#endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) ||
defined(PERL_DECL_PROT)
+pRxo |GV* |softref2xv |NN SV *const sv|NN const char *const what \
+ |const U32 type|NN SV ***spp
+#endif
#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
s |I32 |unpack_rec |NN struct tempsym* symptr|NN const char *s \
==== //depot/perl/embed.h#659 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#658~29853~ 2007-01-17 10:24:50.000000000 -0800
+++ perl/embed.h 2007-01-21 03:44:16.000000000 -0800
@@ -1230,6 +1230,8 @@
#define refto S_refto
#endif
#endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) ||
defined(PERL_DECL_PROT)
+#endif
#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define unpack_rec S_unpack_rec
@@ -3430,6 +3432,10 @@
#define refto(a) S_refto(aTHX_ a)
#endif
#endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) ||
defined(PERL_DECL_PROT)
+#ifdef PERL_CORE
+#endif
+#endif
#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define unpack_rec(a,b,c,d,e) S_unpack_rec(aTHX_ a,b,c,d,e)
==== //depot/perl/pp.c#577 (text) ====
Index: perl/pp.c
--- perl/pp.c#576~29887~ 2007-01-19 13:11:40.000000000 -0800
+++ perl/pp.c 2007-01-21 03:44:16.000000000 -0800
@@ -222,6 +222,50 @@
RETURN;
}
+/* Helper function for pp_rv2sv and pp_rv2av */
+GV *
+Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const U32 type,
+ SV ***spp)
+{
+ dVAR;
+ GV *gv;
+
+ if (PL_op->op_private & HINT_STRICT_REFS) {
+ if (SvOK(sv))
+ Perl_die(aTHX_ PL_no_symref_sv, sv, what);
+ else
+ Perl_die(aTHX_ PL_no_usym, what);
+ }
+ if (!SvOK(sv)) {
+ if (PL_op->op_flags & OPf_REF)
+ Perl_die(aTHX_ PL_no_usym, what);
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit(sv);
+ if (type != SVt_PV && GIMME_V == G_ARRAY) {
+ (*spp)--;
+ return NULL;
+ }
+ **spp = &PL_sv_undef;
+ return NULL;
+ }
+ if ((PL_op->op_flags & OPf_SPECIAL) &&
+ !(PL_op->op_flags & OPf_MOD))
+ {
+ gv = (GV*)gv_fetchsv(sv, 0, type);
+ if (!gv
+ && (!is_gv_magical_sv(sv,0)
+ || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, type))))
+ {
+ **spp = &PL_sv_undef;
+ return NULL;
+ }
+ }
+ else {
+ gv = (GV*)gv_fetchsv(sv, GV_ADD, type);
+ }
+ return gv;
+}
+
PP(pp_rv2sv)
{
dVAR; dSP; dTOPss;
@@ -251,33 +295,9 @@
if (SvROK(sv))
goto wasref;
}
- if (PL_op->op_private & HINT_STRICT_REFS) {
- if (SvOK(sv))
- DIE(aTHX_ PL_no_symref_sv, sv, "a SCALAR");
- else
- DIE(aTHX_ PL_no_usym, "a SCALAR");
- }
- if (!SvOK(sv)) {
- if (PL_op->op_flags & OPf_REF)
- DIE(aTHX_ PL_no_usym, "a SCALAR");
- if (ckWARN(WARN_UNINITIALIZED))
- report_uninit(sv);
- RETSETUNDEF;
- }
- if ((PL_op->op_flags & OPf_SPECIAL) &&
- !(PL_op->op_flags & OPf_MOD))
- {
- gv = (GV*)gv_fetchsv(sv, 0, SVt_PV);
- if (!gv
- && (!is_gv_magical_sv(sv, 0)
- || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV))))
- {
- RETSETUNDEF;
- }
- }
- else {
- gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV);
- }
+ gv = Perl_softref2xv(aTHX_ sv, "a SCALAR", SVt_PV, &sp);
+ if (!gv)
+ RETURN;
}
sv = GvSVn(gv);
}
==== //depot/perl/pp_hot.c#501 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#500~29900~ 2007-01-20 15:40:23.000000000 -0800
+++ perl/pp_hot.c 2007-01-21 03:44:16.000000000 -0800
@@ -836,38 +836,10 @@
if (SvROK(sv))
goto wasref;
}
- if (PL_op->op_private & HINT_STRICT_REFS) {
- if (SvOK(sv))
- DIE(aTHX_ PL_no_symref_sv, sv,
- is_pp_rv2av ? an_array : a_hash);
- else
- DIE(aTHX_ PL_no_usym, is_pp_rv2av ? an_array : a_hash);
- }
- if (!SvOK(sv)) {
- if (PL_op->op_flags & OPf_REF)
- DIE(aTHX_ PL_no_usym, is_pp_rv2av ? an_array : 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, type);
- if (!gv
- && (!is_gv_magical_sv(sv,0)
- || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, type))))
- {
- RETSETUNDEF;
- }
- }
- else {
- gv = (GV*)gv_fetchsv(sv, GV_ADD, type);
- }
+ gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash,
+ type, &sp);
+ if (!gv)
+ RETURN;
}
else {
gv = (GV*)sv;
==== //depot/perl/proto.h#792 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#791~29884~ 2007-01-19 11:27:59.000000000 -0800
+++ perl/proto.h 2007-01-21 03:44:16.000000000 -0800
@@ -3332,6 +3332,14 @@
__attribute__nonnull__(pTHX_1);
#endif
+#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) ||
defined(PERL_DECL_PROT)
+PERL_CALLCONV GV* Perl_softref2xv(pTHX_ SV *const sv, const char *const
what, const U32 type, SV ***spp)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2)
+ __attribute__nonnull__(pTHX_4);
+
+#endif
#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
STATIC I32 S_unpack_rec(pTHX_ struct tempsym* symptr, const char *s, const
char *strbeg, const char *strend, const char **new_s)
End of Patch.
