X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/5637ef5b34a3e8caf72080387a15ea8d81b61baf..90249f0ae5df4271829a2e527b72534b8974ec80:/scope.c?ds=sidebyside diff --git a/scope.c b/scope.c index cc207c0..c767571 100644 --- a/scope.c +++ b/scope.c @@ -160,8 +160,10 @@ Perl_free_tmps(pTHX) /* XXX should tmps_floor live in cxstack? */ const I32 myfloor = PL_tmps_floor; while (PL_tmps_ix > myfloor) { /* clean up after last statement */ - SV* const sv = PL_tmps_stack[PL_tmps_ix]; - PL_tmps_stack[PL_tmps_ix--] = NULL; + SV* const sv = PL_tmps_stack[PL_tmps_ix--]; +#ifdef PERL_POISON + PoisonWith(PL_tmps_stack + PL_tmps_ix + 1, 1, SV *, 0xAB); +#endif if (sv && sv != &PL_sv_undef) { SvTEMP_off(sv); SvREFCNT_dec(sv); /* note, can modify tmps_ix!!! */ @@ -174,7 +176,7 @@ S_save_scalar_at(pTHX_ SV **sptr, const U32 flags) { dVAR; SV * osv; - register SV *sv; + SV *sv; PERL_ARGS_ASSERT_SAVE_SCALAR_AT; @@ -349,7 +351,7 @@ void Perl_save_item(pTHX_ register SV *item) { dVAR; - register SV * const sv = newSVsv(item); + SV * const sv = newSVsv(item); PERL_ARGS_ASSERT_SAVE_ITEM; @@ -682,8 +684,8 @@ I32 Perl_save_alloc(pTHX_ I32 size, I32 pad) { dVAR; - register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix] - - (char*)PL_savestack); + const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix] + - (char*)PL_savestack); const UV elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack)); const UV elems_shifted = elems << SAVE_TIGHT_SHIFT; @@ -702,13 +704,13 @@ void Perl_leave_scope(pTHX_ I32 base) { dVAR; - register SV *sv; - register SV *value; - register GV *gv; - register AV *av; - register HV *hv; + SV *sv; + SV *value; + GV *gv; + AV *av; + HV *hv; void* ptr; - register char* str; + char* str; I32 i; /* Localise the effects of the TAINT_NOT inside the loop. */ bool was = PL_tainted; @@ -911,12 +913,16 @@ Perl_leave_scope(pTHX_ I32 base) SvREADONLY_off(sv); if (SvTHINKFIRST(sv)) - sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF); + sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF + |SV_COW_DROP_PV); if (SvTYPE(sv) == SVt_PVHV) Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv)); if (SvMAGICAL(sv)) - sv_unmagic(sv, PERL_MAGIC_backref), + { + sv_unmagic(sv, PERL_MAGIC_backref); + if (SvTYPE(sv) != SVt_PVCV) mg_free(sv); + } switch (SvTYPE(sv)) { case SVt_NULL: @@ -928,7 +934,14 @@ Perl_leave_scope(pTHX_ I32 base) hv_clear(MUTABLE_HV(sv)); break; case SVt_PVCV: - Perl_croak(aTHX_ "panic: leave_scope pad code"); + { + HEK * const hek = CvNAME_HEK((CV *)sv); + assert(hek); + share_hek_hek(hek); + cv_undef((CV *)sv); + CvNAME_HEK_set(sv, hek); + break; + } default: SvOK_off(sv); break; @@ -941,6 +954,19 @@ Perl_leave_scope(pTHX_ I32 base) switch (SvTYPE(sv)) { /* Console ourselves with a new value */ case SVt_PVAV: *(SV**)ptr = MUTABLE_SV(newAV()); break; case SVt_PVHV: *(SV**)ptr = MUTABLE_SV(newHV()); break; + case SVt_PVCV: + { + SV ** const svp = (SV **)ptr; + + /* Create a stub */ + *svp = newSV_type(SVt_PVCV); + + /* Share name */ + assert(CvNAMED(sv)); + CvNAME_HEK_set(*svp, + share_hek_hek(CvNAME_HEK((CV *)sv))); + break; + } default: *(SV**)ptr = newSV(0); break; } SvREFCNT_dec(sv); /* Cast current value to the winds. */ @@ -1023,9 +1049,12 @@ Perl_leave_scope(pTHX_ I32 base) PL_op = (OP*)SSPOPPTR; break; case SAVEt_HINTS: - if ((PL_hints & HINT_LOCALIZE_HH) && GvHV(PL_hintgv)) { - SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv))); + if ((PL_hints & HINT_LOCALIZE_HH)) { + while (GvHV(PL_hintgv)) { + HV *hv = GvHV(PL_hintgv); GvHV(PL_hintgv) = NULL; + SvREFCNT_dec(MUTABLE_SV(hv)); + } } cophh_free(CopHINTHASH_get(&PL_compiling)); CopHINTHASH_set(&PL_compiling, (COPHH*)SSPOPPTR); @@ -1033,23 +1062,10 @@ Perl_leave_scope(pTHX_ I32 base) if (PL_hints & HINT_LOCALIZE_HH) { SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv))); GvHV(PL_hintgv) = MUTABLE_HV(SSPOPPTR); - assert(GvHV(PL_hintgv)); - } else if (!GvHV(PL_hintgv)) { - /* Need to add a new one manually, else gv_fetchpv() can - add one in this code: - - if (SvTYPE(gv) == SVt_PVGV) { - if (add) { - GvMULTI_on(gv); - gv_init_sv(gv, sv_type); - if (*name=='!' && sv_type == SVt_PVHV && len==1) - require_errno(gv); - } - return gv; - } - - and it won't have the magic set. */ - + } + if (!GvHV(PL_hintgv)) { + /* Need to add a new one manually, else rv2hv can + add one via GvHVn and it won't have the magic set. */ HV *const hv = newHV(); hv_magic(hv, NULL, PERL_MAGIC_hints); GvHV(PL_hintgv) = hv; @@ -1146,9 +1162,6 @@ Perl_leave_scope(pTHX_ I32 base) - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE); PL_savestack_ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE; - if (PL_reg_start_tmp != state->re_state_reg_start_tmp) { - Safefree(PL_reg_start_tmp); - } if (PL_reg_poscache != state->re_state_reg_poscache) { Safefree(PL_reg_poscache); } @@ -1179,6 +1192,7 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) #ifdef DEBUGGING PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]); if (CxTYPE(cx) != CXt_SUBST) { + const char *gimme_text; PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n", PTR2UV(cx->blk_oldcop)); @@ -1186,7 +1200,21 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp); PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n", PTR2UV(cx->blk_oldpm)); - PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR"); + switch (cx->blk_gimme) { + case G_VOID: + gimme_text = "VOID"; + break; + case G_SCALAR: + gimme_text = "SCALAR"; + break; + case G_ARRAY: + gimme_text = "LIST"; + break; + default: + gimme_text = "UNKNOWN"; + break; + } + PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", gimme_text); } switch (CxTYPE(cx)) { case CXt_NULL: @@ -1283,8 +1311,8 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) * Local variables: * c-indentation-style: bsd * c-basic-offset: 4 - * indent-tabs-mode: t + * indent-tabs-mode: nil * End: * - * ex: set ts=8 sts=4 sw=4 noet: + * ex: set ts=8 sts=4 sw=4 et: */