/* pp_hot.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
SV *const value = SvRV(cv);
SvUPGRADE((SV *)gv, SVt_RV);
- SvROK_on(gv);
+ SvPCS_IMPORTED_on(gv);
SvRV_set(gv, value);
SvREFCNT_inc_simple_void(value);
SETs(right);
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log,
"Copy on write: pp_match $& capture, type %d, truebase=%p, t=%p, difference %d\n",
- (int) SvTYPE(TARG), truebase, t,
+ (int) SvTYPE(TARG), (void*)truebase, (void*)t,
(int)(t-truebase));
}
rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
SV* lv;
SV* key2;
if (!defer) {
- DIE(aTHX_ PL_no_helem_sv, keysv);
+ DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
}
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
!is_cow &&
#endif
(SvREADONLY(TARG)
- || ( (SvTYPE(TARG) == SVt_PVGV || SvTYPE(TARG) > SVt_PVLV)
+ || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
+ || SvTYPE(TARG) > SVt_PVLV)
&& !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
DIE(aTHX_ PL_no_modify);
PUTBACK;
return cx->blk_sub.retop;
}
-
-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 */
- }
-}
-
PP(pp_entersub)
{
dVAR; dSP; dPOPss;
else {
sub_name = sv_newmortal();
gv_efullname3(sub_name, gv, NULL);
- DIE(aTHX_ "Undefined subroutine &%"SVf" called", (void*)sub_name);
+ DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name));
}
}
if (!cv)
sub_crush_depth(cv);
#if 0
DEBUG_S(PerlIO_printf(Perl_debug_log,
- "%p entersub returning %p\n", thr, CvSTART(cv)));
+ "%p entersub returning %p\n", (void*)thr, (void*)CvSTART(cv)));
#endif
RETURNOP(CvSTART(cv));
}
SV* const tmpstr = sv_newmortal();
gv_efullname3(tmpstr, CvGV(cv), NULL);
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
- (void*)tmpstr);
+ SVfARG(tmpstr));
}
}
if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC),
"Use of reference \"%"SVf"\" as array index",
- (void*)elemsv);
+ SVfARG(elemsv));
if (elem > 0)
elem -= CopARYBASE_get(PL_curcop);
if (SvTYPE(av) != SVt_PVAV)