X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/07409e015252427f5ec1d8889bbfb78cf39d061d..77263263f2dcc1d77fff24405b11002b13929822:/scope.c

diff --git a/scope.c b/scope.c
index 50f73c1..5ef74ec 100644
--- a/scope.c
+++ b/scope.c
@@ -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
@@ -139,7 +139,7 @@ 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* 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)) {
 	    const 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;
-	    }
 	    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 */
@@ -301,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))
@@ -313,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;
 }
 
@@ -337,22 +308,15 @@ 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 = newSVsv(item);
+    register SV * const sv = newSVsv(item);
 
     SSCHECK(3);
     SSPUSHPTR(item);		/* remember the pointer */
@@ -468,12 +432,8 @@ SV **
 Perl_save_threadsv(pTHX_ PADOFFSET i)
 {
     Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl");
-    (void)i;
-#ifndef HASATTRIBUTE
-    /* No __attribute__, so the compiler doesn't know that croak never returns
-     */
-    return 0;
-#endif
+    PERL_UNUSED_ARG(i);
+    NORETURN_FUNCTION_END;
 }
 
 void
@@ -557,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 */
@@ -592,6 +551,7 @@ void
 Perl_save_aelem(pTHX_ const AV *av, I32 idx, SV **sptr)
 {
     SV *sv;
+    SvGETMAGIC(*sptr);
     SSCHECK(4);
     SSPUSHPTR(SvREFCNT_inc(av));
     SSPUSHINT(idx);
@@ -614,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));
@@ -721,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;
@@ -759,10 +696,13 @@ Perl_leave_scope(pTHX_ I32 base)
 	    gv = (GV*)SSPOPPTR;
 	    if (GvAV(gv)) {
 		AV * const goner = GvAV(gv);
-		SvMAGIC(av) = SvMAGIC(goner);
+		/* 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;
@@ -777,10 +717,10 @@ Perl_leave_scope(pTHX_ I32 base)
 	    gv = (GV*)SSPOPPTR;
 	    if (GvHV(gv)) {
 		HV * const goner = GvHV(gv);
-		SvMAGIC(hv) = SvMAGIC(goner);
+		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;
@@ -842,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))
@@ -869,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];
@@ -1095,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",
@@ -1161,5 +1101,5 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
  * indent-tabs-mode: t
  * End:
  *
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */