This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move Perl_get_db_sub() from pp_hot.c to util.c
[perl5.git] / util.c
diff --git a/util.c b/util.c
index 405c921..114e6ad 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5571,6 +5571,42 @@ Perl_my_strlcpy(char *dst, const char *src, Size_t size)
 }
 #endif
 
+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 ( 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) )))) {
+           /* Use GV from the stack as a fallback. */
+           /* GV is potentially non-unique, or contain different CV. */
+           SV * const tmp = newRV((SV*)cv);
+           sv_setsv(dbsv, tmp);
+           SvREFCNT_dec(tmp);
+       }
+       else {
+           gv_efullname3(dbsv, gv, NULL);
+       }
+    }
+    else {
+       const int type = SvTYPE(dbsv);
+       if (type < SVt_PVIV && type != SVt_IV)
+           sv_upgrade(dbsv, SVt_PVIV);
+       (void)SvIOK_on(dbsv);
+       SvIV_set(dbsv, PTR2IV(cv));     /* Do it the quickest way  */
+    }
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd