X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/766f891612bf493b0430beb068ead367d70cdef6..77263263f2dcc1d77fff24405b11002b13929822:/scope.c diff --git a/scope.c b/scope.c index fe2ceca..5ef74ec 100644 --- a/scope.c +++ b/scope.c @@ -1,7 +1,7 @@ /* scope.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, 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. @@ -46,7 +46,7 @@ PERL_SI * Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) { PERL_SI *si; - New(56, si, 1, PERL_SI); + Newx(si, 1, PERL_SI); si->si_stack = newAV(); AvREAL_off(si->si_stack); av_extend(si->si_stack, stitems > 0 ? stitems-1 : 0); @@ -57,7 +57,7 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) si->si_cxmax = cxitems - 1; si->si_cxix = -1; si->si_type = PERLSI_UNDEF; - New(56, si->si_cxstack, cxitems, PERL_CONTEXT); + Newx(si->si_cxstack, cxitems, PERL_CONTEXT); /* Without any kind of initialising PUSHSUBST() * in pp_subst() will read uninitialised heap. */ Poison(si->si_cxstack, cxitems, PERL_CONTEXT); @@ -67,7 +67,7 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) I32 Perl_cxinc(pTHX) { - IV old_max = cxstack_max; + const IV old_max = cxstack_max; cxstack_max = GROW(cxstack_max); Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */ /* Without any kind of initialising deep enough recursion @@ -90,15 +90,15 @@ Perl_push_scope(pTHX) void Perl_pop_scope(pTHX) { - I32 oldsave = PL_scopestack[--PL_scopestack_ix]; + const I32 oldsave = PL_scopestack[--PL_scopestack_ix]; LEAVE_SCOPE(oldsave); } void Perl_markstack_grow(pTHX) { - I32 oldmax = PL_markstack_max - PL_markstack; - I32 newmax = GROW(oldmax); + const I32 oldmax = PL_markstack_max - PL_markstack; + const I32 newmax = GROW(oldmax); Renew(PL_markstack, newmax, I32); PL_markstack_ptr = PL_markstack + oldmax; @@ -137,9 +137,9 @@ void Perl_free_tmps(pTHX) { /* XXX should tmps_floor live in cxstack? */ - I32 myfloor = PL_tmps_floor; + const I32 myfloor = PL_tmps_floor; while (PL_tmps_ix > myfloor) { /* clean up after last statement */ - SV* sv = PL_tmps_stack[PL_tmps_ix]; + SV* const sv = PL_tmps_stack[PL_tmps_ix]; PL_tmps_stack[PL_tmps_ix--] = Nullsv; if (sv && sv != &PL_sv_undef) { SvTEMP_off(sv); @@ -151,43 +151,17 @@ Perl_free_tmps(pTHX) STATIC SV * S_save_scalar_at(pTHX_ SV **sptr) { - register SV *sv; - SV *osv = *sptr; + SV * const osv = *sptr; + register SV * const sv = *sptr = NEWSV(0,0); - sv = *sptr = NEWSV(0,0); if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) { - MAGIC *mg; - sv_upgrade(sv, SvTYPE(osv)); if (SvGMAGICAL(osv)) { - bool oldtainted = PL_tainted; - mg_get(osv); /* note, can croak! */ - if (PL_tainting && PL_tainted && - (mg = mg_find(osv, PERL_MAGIC_taint))) { - SAVESPTR(mg->mg_obj); - mg->mg_obj = osv; - } + const bool oldtainted = PL_tainted; SvFLAGS(osv) |= (SvFLAGS(osv) & (SVp_NOK|SVp_POK)) >> PRIVSHIFT; PL_tainted = oldtainted; } - SvMAGIC(sv) = SvMAGIC(osv); - /* if it's a special scalar or if it has no 'set' magic, - * propagate the SvREADONLY flag. --rgs 20030922 */ - for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { - if (mg->mg_type == '\0' - || !(mg->mg_virtual && mg->mg_virtual->svt_set)) - { - SvFLAGS(sv) |= SvREADONLY(osv); - break; - } - } - SvFLAGS(sv) |= SvMAGICAL(osv); - /* XXX SvMAGIC() is *shared* between osv and sv. This can - * lead to coredumps when both SVs are destroyed without one - * of their SvMAGIC() slots being NULLed. */ - PL_localizing = 1; - SvSETMAGIC(sv); - PL_localizing = 0; + mg_localize(osv, sv); } return sv; } @@ -196,6 +170,9 @@ SV * Perl_save_scalar(pTHX_ GV *gv) { SV **sptr = &GvSV(gv); + PL_localizing = 1; + SvGETMAGIC(*sptr); + PL_localizing = 0; SSCHECK(3); SSPUSHPTR(SvREFCNT_inc(gv)); SSPUSHPTR(SvREFCNT_inc(*sptr)); @@ -206,6 +183,7 @@ Perl_save_scalar(pTHX_ GV *gv) SV* Perl_save_svref(pTHX_ SV **sptr) { + SvGETMAGIC(*sptr); SSCHECK(3); SSPUSHPTR(sptr); SSPUSHPTR(SvREFCNT_inc(*sptr)); @@ -265,9 +243,9 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) { SSGROW(6); SSPUSHIV((IV)SvLEN(gv)); - SvLEN(gv) = 0; /* forget that anything was allocated here */ + SvLEN_set(gv, 0); /* forget that anything was allocated here */ SSPUSHIV((IV)SvCUR(gv)); - SSPUSHPTR(SvPVX(gv)); + SSPUSHPTR(SvPVX_const(gv)); SvPOK_off(gv); SSPUSHPTR(SvREFCNT_inc(gv)); SSPUSHPTR(GvGP(gv)); @@ -276,7 +254,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) if (empty) { register GP *gp; - Newz(602, gp, 1, GP); + Newxz(gp, 1, GP); if (GvCVu(gv)) PL_sub_generation++; /* taking a method out of circulation */ @@ -287,7 +265,9 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) GvGP(gv) = gp_ref(gp); GvSV(gv) = NEWSV(72,0); GvLINE(gv) = CopLINE(PL_curcop); - GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : ""; + /* XXX Ideally this cast would be replaced with a change to const char* + in the struct. */ + GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) ""; GvEGV(gv) = gv; } else { @@ -299,7 +279,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) AV * Perl_save_ary(pTHX_ GV *gv) { - AV *oav = GvAVn(gv); + AV * const oav = GvAVn(gv); AV *av; if (!AvREAL(oav) && AvREIFY(oav)) @@ -311,15 +291,8 @@ Perl_save_ary(pTHX_ GV *gv) GvAV(gv) = Null(AV*); av = GvAVn(gv); - if (SvMAGIC(oav)) { - SvMAGIC(av) = SvMAGIC(oav); - SvFLAGS((SV*)av) |= SvMAGICAL(oav); - SvMAGICAL_off(oav); - SvMAGIC(oav) = 0; - PL_localizing = 1; - SvSETMAGIC((SV*)av); - PL_localizing = 0; - } + if (SvMAGIC(oav)) + mg_localize((SV*)oav, (SV*)av); return av; } @@ -335,24 +308,16 @@ Perl_save_hash(pTHX_ GV *gv) GvHV(gv) = Null(HV*); hv = GvHVn(gv); - if (SvMAGIC(ohv)) { - SvMAGIC(hv) = SvMAGIC(ohv); - SvFLAGS((SV*)hv) |= SvMAGICAL(ohv); - SvMAGICAL_off(ohv); - SvMAGIC(ohv) = 0; - PL_localizing = 1; - SvSETMAGIC((SV*)hv); - PL_localizing = 0; - } + if (SvMAGIC(ohv)) + mg_localize((SV*)ohv, (SV*)hv); return hv; } void Perl_save_item(pTHX_ register SV *item) { - register SV *sv = NEWSV(0,0); + register SV * const sv = newSVsv(item); - sv_setsv(sv,item); SSCHECK(3); SSPUSHPTR(item); /* remember the pointer */ SSPUSHPTR(sv); /* remember the value */ @@ -467,7 +432,8 @@ SV ** Perl_save_threadsv(pTHX_ PADOFFSET i) { Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl"); - return 0; + PERL_UNUSED_ARG(i); + NORETURN_FUNCTION_END; } void @@ -551,11 +517,10 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen) void Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg) { - register SV *sv; register I32 i; for (i = 1; i <= maxsarg; i++) { - sv = NEWSV(0,0); + register SV * const sv = NEWSV(0,0); sv_setsv(sv,sarg[i]); SSCHECK(3); SSPUSHPTR(sarg[i]); /* remember the pointer */ @@ -583,9 +548,10 @@ Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p) } void -Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) +Perl_save_aelem(pTHX_ const AV *av, I32 idx, SV **sptr) { SV *sv; + SvGETMAGIC(*sptr); SSCHECK(4); SSPUSHPTR(SvREFCNT_inc(av)); SSPUSHINT(idx); @@ -593,7 +559,7 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) SSPUSHINT(SAVEt_AELEM); /* if it gets reified later, the restore will have the wrong refcnt */ if (!AvREAL(av) && AvREIFY(av)) - SvREFCNT_inc(*sptr); + (void)SvREFCNT_inc(*sptr); save_scalar_at(sptr); sv = *sptr; /* If we're localizing a tied array element, this new sv @@ -608,6 +574,7 @@ void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) { SV *sv; + SvGETMAGIC(*sptr); SSCHECK(4); SSPUSHPTR(SvREFCNT_inc(hv)); SSPUSHPTR(SvREFCNT_inc(key)); @@ -634,9 +601,9 @@ Perl_save_op(pTHX) I32 Perl_save_alloc(pTHX_ I32 size, I32 pad) { - register I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix] + register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix] - (char*)PL_savestack); - register I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack)); + register const I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack)); /* SSCHECK may not be good enough */ while (PL_savestack_ix + elems + 2 > PL_savestack_max) @@ -715,30 +682,6 @@ Perl_leave_scope(pTHX_ I32 base) DEBUG_S(PerlIO_printf(Perl_debug_log, "restore svref: %p %p:%s -> %p:%s\n", ptr, sv, SvPEEK(sv), value, SvPEEK(value))); - if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && - SvTYPE(sv) != SVt_PVGV) - { - (void)SvUPGRADE(value, SvTYPE(sv)); - SvMAGIC(value) = SvMAGIC(sv); - SvFLAGS(value) |= SvMAGICAL(sv); - SvMAGICAL_off(sv); - SvMAGIC(sv) = 0; - } - /* XXX This branch is pretty bogus. This code irretrievably - * clears(!) the magic on the SV (either to avoid further - * croaking that might ensue when the SvSETMAGIC() below is - * called, or to avoid two different SVs pointing at the same - * SvMAGIC()). This needs a total rethink. --GSAR */ - else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) && - SvTYPE(value) != SVt_PVGV) - { - SvFLAGS(value) |= (SvFLAGS(value) & - (SVp_NOK|SVp_POK)) >> PRIVSHIFT; - SvMAGICAL_off(value); - /* XXX this is a leak when we get here because the - * mg_get() in save_scalar_at() croaked */ - SvMAGIC(value) = 0; - } *(SV**)ptr = value; SvREFCNT_dec(sv); PL_localizing = 2; @@ -752,11 +695,14 @@ Perl_leave_scope(pTHX_ I32 base) av = (AV*)SSPOPPTR; gv = (GV*)SSPOPPTR; if (GvAV(gv)) { - AV *goner = GvAV(gv); - SvMAGIC(av) = SvMAGIC(goner); + AV * const goner = GvAV(gv); + /* FIXME - this is a temporary hack until we work out what + the correct behaviour for magic should be. */ + sv_unmagic((SV*)goner, PERL_MAGIC_arylen_p); + SvMAGIC_set(av, SvMAGIC(goner)); SvFLAGS((SV*)av) |= SvMAGICAL(goner); SvMAGICAL_off(goner); - SvMAGIC(goner) = 0; + SvMAGIC_set(goner, NULL); SvREFCNT_dec(goner); } GvAV(gv) = av; @@ -770,11 +716,11 @@ Perl_leave_scope(pTHX_ I32 base) hv = (HV*)SSPOPPTR; gv = (GV*)SSPOPPTR; if (GvHV(gv)) { - HV *goner = GvHV(gv); - SvMAGIC(hv) = SvMAGIC(goner); + HV * const goner = GvHV(gv); + SvMAGIC_set(hv, SvMAGIC(goner)); SvFLAGS(hv) |= SvMAGICAL(goner); SvMAGICAL_off(goner); - SvMAGIC(goner) = 0; + SvMAGIC_set(goner, NULL); SvREFCNT_dec(goner); } GvHV(gv) = hv; @@ -836,12 +782,12 @@ Perl_leave_scope(pTHX_ I32 base) case SAVEt_GP: /* scalar reference */ ptr = SSPOPPTR; gv = (GV*)SSPOPPTR; - if (SvPVX(gv) && SvLEN(gv) > 0) { - Safefree(SvPVX(gv)); + if (SvPVX_const(gv) && SvLEN(gv) > 0) { + Safefree(SvPVX_mutable(gv)); } - SvPVX(gv) = (char *)SSPOPPTR; - SvCUR(gv) = (STRLEN)SSPOPIV; - SvLEN(gv) = (STRLEN)SSPOPIV; + SvPV_set(gv, (char *)SSPOPPTR); + SvCUR_set(gv, (STRLEN)SSPOPIV); + SvLEN_set(gv, (STRLEN)SSPOPIV); gp_free(gv); GvGP(gv) = (GP*)ptr; if (GvCVu(gv)) @@ -863,7 +809,7 @@ Perl_leave_scope(pTHX_ I32 base) break; case SAVEt_FREEPV: ptr = SSPOPPTR; - Safefree((char*)ptr); + Safefree(ptr); break; case SAVEt_CLEARSV: ptr = (void*)&PL_curpad[SSPOPLONG]; @@ -909,7 +855,7 @@ Perl_leave_scope(pTHX_ I32 base) SvPADSTALE_on(sv); /* mark as no longer live */ } else { /* Someone has a claim on this, so abandon it. */ - U32 padflags = SvFLAGS(sv) & (SVs_PADMY|SVs_PADTMP); + const U32 padflags = SvFLAGS(sv) & (SVs_PADMY|SVs_PADTMP); switch (SvTYPE(sv)) { /* Console ourselves with a new value */ case SVt_PVAV: *(SV**)ptr = (SV*)newAV(); break; case SVt_PVHV: *(SV**)ptr = (SV*)newHV(); break; @@ -970,7 +916,7 @@ Perl_leave_scope(pTHX_ I32 base) hv = (HV*)SSPOPPTR; ptr = hv_fetch_ent(hv, sv, 1, 0); if (ptr) { - SV *oval = HeVAL((HE*)ptr); + const SV * const oval = HeVAL((HE*)ptr); if (oval && oval != &PL_sv_undef) { ptr = &HeVAL((HE*)ptr); if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) @@ -1008,7 +954,7 @@ Perl_leave_scope(pTHX_ I32 base) break; case SAVEt_PADSV: { - PADOFFSET off = (PADOFFSET)SSPOPLONG; + const PADOFFSET off = (PADOFFSET)SSPOPLONG; ptr = SSPOPPTR; if (ptr) AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR; @@ -1025,8 +971,8 @@ Perl_leave_scope(pTHX_ I32 base) break; case SAVEt_SET_SVFLAGS: { - U32 val = (U32)SSPOPINT; - U32 mask = (U32)SSPOPINT; + const U32 val = (U32)SSPOPINT; + const U32 mask = (U32)SSPOPINT; sv = (SV*)SSPOPPTR; SvFLAGS(sv) &= ~mask; SvFLAGS(sv) |= val; @@ -1089,7 +1035,7 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) PL_op_desc[cx->blk_eval.old_op_type]); if (cx->blk_eval.old_namesv) PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n", - SvPVX(cx->blk_eval.old_namesv)); + SvPVX_const(cx->blk_eval.old_namesv)); PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n", PTR2UV(cx->blk_eval.old_eval_root)); PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%"UVxf"\n", @@ -1147,3 +1093,13 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) } #endif /* DEBUGGING */ } + +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */