Change 29434 by [EMAIL PROTECTED] on 2006/12/01 22:51:22
Make get_db_sub non-static, and call it from pp_goto, which allows the
removal of duplicate code. (The conversion of GvSV(PL_DBsub) to
GvSVn(PL_DBsub) implicit in this change should fix a failure with
Devel::SmallProf.)
Affected files ...
... //depot/perl/embed.fnc#431 edit
... //depot/perl/embed.h#641 edit
... //depot/perl/pp_ctl.c#588 edit
... //depot/perl/pp_hot.c#489 edit
... //depot/perl/proto.h#772 edit
Differences ...
==== //depot/perl/embed.fnc#431 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#430~29433~ 2006-12-01 14:28:11.000000000 -0800
+++ perl/embed.fnc 2006-12-01 14:51:22.000000000 -0800
@@ -266,6 +266,7 @@
#if !defined(HAS_GETENV_LEN)
p |char* |getenv_len |NN const char* key|NN unsigned long *len
#endif
+pox |void |get_db_sub |NULLOK SV **svp|NN CV *cv
Ap |void |gp_free |NULLOK GV* gv
Ap |GP* |gp_ref |NULLOK GP* gp
Ap |GV* |gv_AVadd |NN GV* gv
@@ -1277,7 +1278,6 @@
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
s |void |do_oddball |NN HV *hash|NN SV **relem|NN SV **firstrelem
-s |void |get_db_sub |NN SV **svp|NN CV *cv
sR |SV* |method_common |NN SV* meth|NULLOK U32* hashp
#endif
==== //depot/perl/embed.h#641 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#640~29430~ 2006-12-01 05:59:27.000000000 -0800
+++ perl/embed.h 2006-12-01 14:51:22.000000000 -0800
@@ -1274,7 +1274,6 @@
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define do_oddball S_do_oddball
-#define get_db_sub S_get_db_sub
#define method_common S_method_common
#endif
#endif
@@ -2458,6 +2457,8 @@
#define getenv_len(a,b) Perl_getenv_len(aTHX_ a,b)
#endif
#endif
+#ifdef PERL_CORE
+#endif
#define gp_free(a) Perl_gp_free(aTHX_ a)
#define gp_ref(a) Perl_gp_ref(aTHX_ a)
#define gv_AVadd(a) Perl_gv_AVadd(aTHX_ a)
@@ -3477,7 +3478,6 @@
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define do_oddball(a,b,c) S_do_oddball(aTHX_ a,b,c)
-#define get_db_sub(a,b) S_get_db_sub(aTHX_ a,b)
#define method_common(a,b) S_method_common(aTHX_ a,b)
#endif
#endif
==== //depot/perl/pp_ctl.c#588 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#587~29433~ 2006-12-01 14:28:11.000000000 -0800
+++ perl/pp_ctl.c 2006-12-01 14:51:22.000000000 -0800
@@ -2475,21 +2475,7 @@
}
}
if (PERLDB_SUB) { /* Checking curstash breaks DProf. */
- /*
- * We do not care about using sv to call CV;
- * it's for informational purposes only.
- */
- SV * const sv = GvSV(PL_DBsub);
- save_item(sv);
- if (PERLDB_SUB_NN) {
- const int type = SvTYPE(sv);
- if (type < SVt_PVIV && type != SVt_IV)
- sv_upgrade(sv, SVt_PVIV);
- (void)SvIOK_on(sv);
- SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
- } else {
- gv_efullname3(sv, CvGV(cv), NULL);
- }
+ Perl_get_db_sub(aTHX_ NULL, cv);
if (PERLDB_GOTO) {
CV * const gotocv = get_cv("DB::goto", FALSE);
if (gotocv) {
==== //depot/perl/pp_hot.c#489 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#488~29433~ 2006-12-01 14:28:11.000000000 -0800
+++ perl/pp_hot.c 2006-12-01 14:51:22.000000000 -0800
@@ -2683,20 +2683,23 @@
}
-STATIC void
-S_get_db_sub(pTHX_ SV **svp, CV *cv)
+void
+Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
{
dVAR;
SV * const dbsv = GvSVn(PL_DBsub);
+ /* We do not care about using sv to call CV;
+ * it's for informational purposes only.
+ */
save_item(dbsv);
if (!PERLDB_SUB_NN) {
GV * const gv = CvGV(cv);
- if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+ if ( svp && ((CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
|| strEQ(GvNAME(gv), "END")
|| ((GvCV(gv) != cv) && /* Could be imported, and old sub
redefined. */
- !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) ))) {
+ !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) )))) {
/* Use GV from the stack as a fallback. */
/* GV is potentially non-unique, or contain different CV. */
SV * const tmp = newRV((SV*)cv);
@@ -2823,7 +2826,7 @@
if (CvASSERTION(cv) && PL_DBassertion)
sv_setiv(PL_DBassertion, 1);
- get_db_sub(&sv, cv);
+ Perl_get_db_sub(aTHX_ &sv, cv);
if (CvISXSUB(cv))
PL_curcopdb = PL_curcop;
cv = GvCV(PL_DBsub);
==== //depot/perl/proto.h#772 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#771~29433~ 2006-12-01 14:28:11.000000000 -0800
+++ perl/proto.h 2006-12-01 14:51:22.000000000 -0800
@@ -588,6 +588,9 @@
__attribute__nonnull__(pTHX_2);
#endif
+PERL_CALLCONV void Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
+ __attribute__nonnull__(pTHX_2);
+
PERL_CALLCONV void Perl_gp_free(pTHX_ GV* gv);
PERL_CALLCONV GP* Perl_gp_ref(pTHX_ GP* gp);
PERL_CALLCONV GV* Perl_gv_AVadd(pTHX_ GV* gv)
@@ -3465,10 +3468,6 @@
__attribute__nonnull__(pTHX_2)
__attribute__nonnull__(pTHX_3);
-STATIC void S_get_db_sub(pTHX_ SV **svp, CV *cv)
- __attribute__nonnull__(pTHX_1)
- __attribute__nonnull__(pTHX_2);
-
STATIC SV* S_method_common(pTHX_ SV* meth, U32* hashp)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
End of Patch.
