X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=6012d32f9ec666ac536cb337be9c4328cd98a0f8;hb=e08926902e591e5c2d12e9e6e88a0d5ec7998770;hp=4e3504c6e28463f7b91d452d177d07ad2793a7cf;hpb=cb421d5edd945a7b56ee0a400c6b91d3acf45381;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 4e3504c..6012d32 100644
--- a/mg.c
+++ b/mg.c
@@ -85,6 +85,9 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
 {
     dVAR;
     MGS* mgs;
+
+    PERL_ARGS_ASSERT_SAVE_MAGIC;
+
     assert(SvMAGICAL(sv));
     /* Turning READONLY off for a copy-on-write scalar (including shared
        hash keys) is a bad idea.  */
@@ -118,17 +121,23 @@ void
 Perl_mg_magical(pTHX_ SV *sv)
 {
     const MAGIC* mg;
+    PERL_ARGS_ASSERT_MG_MAGICAL;
     PERL_UNUSED_CONTEXT;
-    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-	const MGVTBL* const vtbl = mg->mg_virtual;
-	if (vtbl) {
-	    if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
-		SvGMAGICAL_on(sv);
-	    if (vtbl->svt_set)
-		SvSMAGICAL_on(sv);
-	    if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
-		SvRMAGICAL_on(sv);
-	}
+    if ((mg = SvMAGIC(sv))) {
+	SvRMAGICAL_off(sv);
+	do {
+	    const MGVTBL* const vtbl = mg->mg_virtual;
+	    if (vtbl) {
+		if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
+		    SvGMAGICAL_on(sv);
+		if (vtbl->svt_set)
+		    SvSMAGICAL_on(sv);
+		if (vtbl->svt_clear)
+		    SvRMAGICAL_on(sv);
+	    }
+	} while ((mg = mg->mg_moremagic));
+	if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)))
+	    SvRMAGICAL_on(sv);
     }
 }
 
@@ -138,6 +147,7 @@ Perl_mg_magical(pTHX_ SV *sv)
 STATIC bool
 S_is_container_magic(const MAGIC *mg)
 {
+    assert(mg);
     switch (mg->mg_type) {
     case PERL_MAGIC_bm:
     case PERL_MAGIC_fm:
@@ -184,6 +194,8 @@ Perl_mg_get(pTHX_ SV *sv)
     /* guard against sv having being freed midway by holding a private
        reference. */
 
+    PERL_ARGS_ASSERT_MG_GET;
+
     /* sv_2mortal has this side effect of turning on the TEMP flag, which can
        cause the SV's buffer to get stolen (and maybe other stuff).
        So restore it.
@@ -262,6 +274,8 @@ Perl_mg_set(pTHX_ SV *sv)
     MAGIC* mg;
     MAGIC* nextmg;
 
+    PERL_ARGS_ASSERT_MG_SET;
+
     save_magic(mgs_ix, sv);
 
     for (mg = SvMAGIC(sv); mg; mg = nextmg) {
@@ -296,6 +310,8 @@ Perl_mg_length(pTHX_ SV *sv)
     MAGIC* mg;
     STRLEN len;
 
+    PERL_ARGS_ASSERT_MG_LENGTH;
+
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
         const MGVTBL * const vtbl = mg->mg_virtual;
 	if (vtbl && vtbl->svt_len) {
@@ -308,12 +324,15 @@ Perl_mg_length(pTHX_ SV *sv)
 	}
     }
 
-    if (DO_UTF8(sv)) {
+    {
+	/* You can't know whether it's UTF-8 until you get the string again...
+	 */
         const U8 *s = (U8*)SvPV_const(sv, len);
-	len = utf8_length(s, s + len);
+
+	if (DO_UTF8(sv)) {
+	    len = utf8_length(s, s + len);
+	}
     }
-    else
-        (void)SvPV_const(sv, len);
     return len;
 }
 
@@ -322,6 +341,8 @@ Perl_mg_size(pTHX_ SV *sv)
 {
     MAGIC* mg;
 
+    PERL_ARGS_ASSERT_MG_SIZE;
+
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
         const MGVTBL* const vtbl = mg->mg_virtual;
 	if (vtbl && vtbl->svt_len) {
@@ -361,6 +382,8 @@ Perl_mg_clear(pTHX_ SV *sv)
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     MAGIC* mg;
 
+    PERL_ARGS_ASSERT_MG_CLEAR;
+
     save_magic(mgs_ix, sv);
 
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
@@ -410,6 +433,9 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
 {
     int count = 0;
     MAGIC* mg;
+
+    PERL_ARGS_ASSERT_MG_COPY;
+
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
         const MGVTBL* const vtbl = mg->mg_virtual;
 	if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){
@@ -447,6 +473,9 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
 {
     dVAR;
     MAGIC *mg;
+
+    PERL_ARGS_ASSERT_MG_LOCALIZE;
+
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 	const MGVTBL* const vtbl = mg->mg_virtual;
 	if (!S_is_container_magic(mg))
@@ -483,6 +512,9 @@ Perl_mg_free(pTHX_ SV *sv)
 {
     MAGIC* mg;
     MAGIC* moremagic;
+
+    PERL_ARGS_ASSERT_MG_FREE;
+
     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
         const MGVTBL* const vtbl = mg->mg_virtual;
 	moremagic = mg->mg_moremagic;
@@ -497,8 +529,10 @@ Perl_mg_free(pTHX_ SV *sv)
 	if (mg->mg_flags & MGf_REFCOUNTED)
 	    SvREFCNT_dec(mg->mg_obj);
 	Safefree(mg);
+	SvMAGIC_set(sv, moremagic);
     }
     SvMAGIC_set(sv, NULL);
+    SvMAGICAL_off(sv);
     return 0;
 }
 
@@ -510,19 +544,21 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
     dVAR;
     PERL_UNUSED_ARG(sv);
 
+    PERL_ARGS_ASSERT_MAGIC_REGDATA_CNT;
+
     if (PL_curpm) {
 	register const REGEXP * const rx = PM_GETRE(PL_curpm);
 	if (rx) {
 	    if (mg->mg_obj) {			/* @+ */
 		/* return the number possible */
-		return rx->nparens;
+		return RX_NPARENS(rx);
 	    } else {				/* @- */
-		I32 paren = rx->lastparen;
+		I32 paren = RX_LASTPAREN(rx);
 
 		/* return the last filled */
 		while ( paren >= 0
-			&& (rx->offs[paren].start == -1
-			    || rx->offs[paren].end == -1) )
+			&& (RX_OFFS(rx)[paren].start == -1
+			    || RX_OFFS(rx)[paren].end == -1) )
 		    paren--;
 		return (U32)paren;
 	    }
@@ -536,6 +572,9 @@ int
 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_MAGIC_REGDATUM_GET;
+
     if (PL_curpm) {
 	register const REGEXP * const rx = PM_GETRE(PL_curpm);
 	if (rx) {
@@ -544,9 +583,9 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 	    register I32 t;
 	    if (paren < 0)
 		return 0;
-	    if (paren <= (I32)rx->nparens &&
-		(s = rx->offs[paren].start) != -1 &&
-		(t = rx->offs[paren].end) != -1)
+	    if (paren <= (I32)RX_NPARENS(rx) &&
+		(s = RX_OFFS(rx)[paren].start) != -1 &&
+		(t = RX_OFFS(rx)[paren].end) != -1)
 		{
 		    register I32 i;
 		    if (mg->mg_obj)		/* @+ */
@@ -555,7 +594,7 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 			i = s;
 
 		    if (i > 0 && RX_MATCH_UTF8(rx)) {
-			const char * const b = rx->subbeg;
+			const char * const b = RX_SUBBEG(rx);
 			if (b)
 			    i = utf8_length((U8*)b, (U8*)(b+i));
 		    }
@@ -570,6 +609,7 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_REGDATUM_SET;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
     Perl_croak(aTHX_ PL_no_modify);
@@ -585,6 +625,8 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
     register const REGEXP * rx;
     const char * const remaining = mg->mg_ptr + 1;
 
+    PERL_ARGS_ASSERT_MAGIC_LEN;
+
     switch (*mg->mg_ptr) {
     case '\020':		
       if (*remaining == '\0') { /* ^P */
@@ -631,14 +673,14 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 	}
     case '+':
 	if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-	    paren = rx->lastparen;
+	    paren = RX_LASTPAREN(rx);
 	    if (paren)
 		goto getparen;
 	}
 	return 0;
     case '\016': /* ^N */
 	if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-	    paren = rx->lastcloseparen;
+	    paren = RX_LASTCLOSEPAREN(rx);
 	    if (paren)
 		goto getparen;
 	}
@@ -667,6 +709,8 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 void
 Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const sv)
 {
+    PERL_ARGS_ASSERT_EMULATE_COP_IO;
+
     if (!(CopHINTS_get(c) & (HINT_LEXICAL_IO_IN|HINT_LEXICAL_IO_OUT)))
 	sv_setsv(sv, &PL_sv_undef);
     else {
@@ -700,6 +744,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     const char * const remaining = mg->mg_ptr + 1;
     const char nextchar = *remaining;
 
+    PERL_ARGS_ASSERT_MAGIC_GET;
+
     switch (*mg->mg_ptr) {
     case '\001':		/* ^A */
 	sv_setsv(sv, PL_bodytarget);
@@ -782,10 +828,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	sv_setiv(sv, (IV)PL_hints);
 	break;
     case '\011':		/* ^I */ /* NOT \t in EBCDIC */
-	if (PL_inplace)
-	    sv_setpv(sv, PL_inplace);
-	else
-	    sv_setsv(sv, &PL_sv_undef);
+	sv_setpv(sv, PL_inplace); /* Will undefine sv if PL_inplace is NULL */
 	break;
     case '\017':		/* ^O & ^OPEN */
 	if (nextchar == '\0') {
@@ -888,8 +931,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '+':
 	if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-	    if (rx->lastparen) {
-	        CALLREG_NUMBUF_FETCH(rx,rx->lastparen,sv);
+	    if (RX_LASTPAREN(rx)) {
+	        CALLREG_NUMBUF_FETCH(rx,RX_LASTPAREN(rx),sv);
 	        break;
 	    }
 	}
@@ -897,8 +940,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '\016':		/* ^N */
 	if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-	    if (rx->lastcloseparen) {
-	        CALLREG_NUMBUF_FETCH(rx,rx->lastcloseparen,sv);
+	    if (RX_LASTCLOSEPAREN(rx)) {
+	        CALLREG_NUMBUF_FETCH(rx,RX_LASTCLOSEPAREN(rx),sv);
 	        break;
 	    }
 
@@ -1039,6 +1082,8 @@ Perl_magic_getuvar(pTHX_ SV *sv, MAGIC *mg)
 {
     struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
 
+    PERL_ARGS_ASSERT_MAGIC_GETUVAR;
+
     if (uf && uf->uf_val)
 	(*uf->uf_val)(aTHX_ uf->uf_index, sv);
     return 0;
@@ -1053,6 +1098,8 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
     const char * const ptr = MgPV_const(mg,klen);
     my_setenv(ptr, s);
 
+    PERL_ARGS_ASSERT_MAGIC_SETENV;
+
 #ifdef DYNAMIC_ENV_FETCH
      /* We just undefd an environment var.  Is a replacement */
      /* waiting in the wings? */
@@ -1132,6 +1179,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_CLEARENV;
     PERL_UNUSED_ARG(sv);
     my_setenv(MgPV_nolen_const(mg),NULL);
     return 0;
@@ -1141,6 +1189,7 @@ int
 Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
+    PERL_ARGS_ASSERT_MAGIC_SET_ALL_ENV;
     PERL_UNUSED_ARG(mg);
 #if defined(VMS)
     Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
@@ -1163,6 +1212,7 @@ int
 Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
+    PERL_ARGS_ASSERT_MAGIC_CLEAR_ALL_ENV;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
 #if defined(VMS)
@@ -1188,6 +1238,9 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
     dVAR;
     /* Are we fetching a signal entry? */
     const I32 i = whichsig(MgPV_nolen_const(mg));
+
+    PERL_ARGS_ASSERT_MAGIC_GETSIG;
+
     if (i > 0) {
     	if(PL_psig_ptr[i])
     	    sv_setsv(sv,PL_psig_ptr[i]);
@@ -1220,6 +1273,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
      */
     dVAR;
     register const char * const s = MgPV_nolen_const(mg);
+    PERL_ARGS_ASSERT_MAGIC_CLEARSIG;
     PERL_UNUSED_ARG(sv);
     if (*s == '_') {
 	SV** svp = NULL;
@@ -1245,7 +1299,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
 	    sigaddset(&set,i);
 	    sigprocmask(SIG_BLOCK, &set, &save);
 	    ENTER;
-	    save_sv = newSVpv((char *)(&save), sizeof(sigset_t));
+	    save_sv = newSVpvn((char *)(&save), sizeof(sigset_t));
 	    SAVEFREESV(save_sv);
 	    SAVEDESTRUCTOR_X(restore_sigmask, save_sv);
 #endif
@@ -1276,35 +1330,6 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }
 
-/*
- * The signal handling nomenclature has gotten a bit confusing since the advent of
- * safe signals.  S_raise_signal only raises signals by analogy with what the 
- * underlying system's signal mechanism does.  It might be more proper to say that
- * it defers signals that have already been raised and caught.  
- *
- * PL_sig_pending and PL_psig_pend likewise do not track signals that are pending 
- * in the sense of being on the system's signal queue in between raising and delivery.  
- * They are only pending on Perl's deferral list, i.e., they track deferred signals 
- * awaiting delivery after the current Perl opcode completes and say nothing about
- * signals raised but not yet caught in the underlying signal implementation.
- */
-
-#ifndef SIG_PENDING_DIE_COUNT
-#  define SIG_PENDING_DIE_COUNT 120
-#endif
-
-static void
-S_raise_signal(pTHX_ int sig)
-{
-    dVAR;
-    /* Set a flag to say this signal is pending */
-    PL_psig_pend[sig]++;
-    /* And one to say _a_ signal is pending */
-    if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT)
-	Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded",
-		(unsigned long)SIG_PENDING_DIE_COUNT);
-}
-
 Signal_t
 #if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
 Perl_csighandler(int sig, siginfo_t *sip PERL_UNUSED_DECL, void *uap PERL_UNUSED_DECL)
@@ -1317,8 +1342,6 @@ Perl_csighandler(int sig)
 #else
     dTHX;
 #endif
-#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
-#endif
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
     (void) rsignal(sig, PL_csighandlerp);
     if (PL_sig_ignoring[sig]) return;
@@ -1331,9 +1354,7 @@ Perl_csighandler(int sig)
             exit(1);
 #endif
 #endif
-#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
-#endif
-   if (
+    if (
 #ifdef SIGILL
 	   sig == SIGILL ||
 #endif
@@ -1351,8 +1372,19 @@ Perl_csighandler(int sig)
 #else
 	(*PL_sighandlerp)(sig);
 #endif
-   else
-	S_raise_signal(aTHX_ sig);
+    else {
+	/* Set a flag to say this signal is pending, that is awaiting delivery after
+	 * the current Perl opcode completes */
+	PL_psig_pend[sig]++;
+
+#ifndef SIG_PENDING_DIE_COUNT
+#  define SIG_PENDING_DIE_COUNT 120
+#endif
+	/* And one to say _a_ signal is pending */
+	if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT)
+	    Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded",
+		       (unsigned long)SIG_PENDING_DIE_COUNT);
+    }
 }
 
 #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
@@ -1413,8 +1445,10 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     sigset_t set, save;
     SV* save_sv;
 #endif
-
     register const char *s = MgPV_const(mg,len);
+
+    PERL_ARGS_ASSERT_MAGIC_SETSIG;
+
     if (*s == '_') {
 	if (strEQ(s,"__DIE__"))
 	    svp = &PL_diehook;
@@ -1442,7 +1476,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 	sigaddset(&set,i);
 	sigprocmask(SIG_BLOCK, &set, &save);
 	ENTER;
-	save_sv = newSVpv((char *)(&save), sizeof(sigset_t));
+	save_sv = newSVpvn((char *)(&save), sizeof(sigset_t));
 	SAVEFREESV(save_sv);
 	SAVEDESTRUCTOR_X(restore_sigmask, save_sv);
 #endif
@@ -1505,7 +1539,8 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 	 * tell whether HINT_STRICT_REFS is in force or not.
 	 */
 	if (!strchr(s,':') && !strchr(s,'\''))
-	    Perl_sv_insert(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"));
+	    Perl_sv_insert_flags(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"),
+				 SV_GMAGIC);
 	if (i)
 	    (void)rsignal(i, PL_csighandlerp);
 	else
@@ -1526,6 +1561,8 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     HV* stash;
+
+    PERL_ARGS_ASSERT_MAGIC_SETISA;
     PERL_UNUSED_ARG(sv);
 
     /* Bail out if destruction is going on */
@@ -1546,10 +1583,37 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
     stash = GvSTASH(
         SvTYPE(mg->mg_obj) == SVt_PVGV
             ? (GV*)mg->mg_obj
-            : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
+            : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
     );
 
-    mro_isa_changed_in(stash);
+    if (stash)
+	mro_isa_changed_in(stash);
+
+    return 0;
+}
+
+int
+Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
+{
+    dVAR;
+    HV* stash;
+
+    PERL_ARGS_ASSERT_MAGIC_CLEARISA;
+
+    /* Bail out if destruction is going on */
+    if(PL_dirty) return 0;
+
+    av_clear((AV*)sv);
+
+    /* XXX see comments in magic_setisa */
+    stash = GvSTASH(
+        SvTYPE(mg->mg_obj) == SVt_PVGV
+            ? (GV*)mg->mg_obj
+            : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
+    );
+
+    if (stash)
+	mro_isa_changed_in(stash);
 
     return 0;
 }
@@ -1558,6 +1622,7 @@ int
 Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
+    PERL_ARGS_ASSERT_MAGIC_SETAMAGIC;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
     PL_amagic_generation++;
@@ -1570,6 +1635,8 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg)
 {
     HV * const hv = (HV*)LvTARG(sv);
     I32 i = 0;
+
+    PERL_ARGS_ASSERT_MAGIC_GETNKEYS;
     PERL_UNUSED_ARG(mg);
 
     if (hv) {
@@ -1589,6 +1656,7 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_SETNKEYS;
     PERL_UNUSED_ARG(mg);
     if (LvTARG(sv)) {
 	hv_ksplit((HV*)LvTARG(sv), SvIV(sv));
@@ -1603,18 +1671,20 @@ S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int
     dVAR;
     dSP;
 
+    PERL_ARGS_ASSERT_MAGIC_METHCALL;
+
     PUSHMARK(SP);
     EXTEND(SP, n);
     PUSHs(SvTIED_obj(sv, mg));
     if (n > 1) {
 	if (mg->mg_ptr) {
 	    if (mg->mg_len >= 0)
-		PUSHs(sv_2mortal(newSVpvn(mg->mg_ptr, mg->mg_len)));
+		mPUSHp(mg->mg_ptr, mg->mg_len);
 	    else if (mg->mg_len == HEf_SVKEY)
 		PUSHs((SV*)mg->mg_ptr);
 	}
 	else if (mg->mg_type == PERL_MAGIC_tiedelem) {
-	    PUSHs(sv_2mortal(newSViv(mg->mg_len)));
+	    mPUSHi(mg->mg_len);
 	}
     }
     if (n > 2) {
@@ -1630,6 +1700,8 @@ S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth)
 {
     dVAR; dSP;
 
+    PERL_ARGS_ASSERT_MAGIC_METHPACK;
+
     ENTER;
     SAVETMPS;
     PUSHSTACKi(PERLSI_MAGIC);
@@ -1647,6 +1719,8 @@ S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth)
 int
 Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_GETPACK;
+
     if (mg->mg_ptr)
 	mg->mg_flags |= MGf_GSKIP;
     magic_methpack(sv,mg,"FETCH");
@@ -1657,6 +1731,9 @@ int
 Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR; dSP;
+
+    PERL_ARGS_ASSERT_MAGIC_SETPACK;
+
     ENTER;
     PUSHSTACKi(PERLSI_MAGIC);
     magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
@@ -1668,6 +1745,8 @@ Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_clearpack(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_CLEARPACK;
+
     return magic_methpack(sv,mg,"DELETE");
 }
 
@@ -1678,6 +1757,8 @@ Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
     dVAR; dSP;
     I32 retval = 0;
 
+    PERL_ARGS_ASSERT_MAGIC_SIZEPACK;
+
     ENTER;
     SAVETMPS;
     PUSHSTACKi(PERLSI_MAGIC);
@@ -1698,6 +1779,8 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR; dSP;
 
+    PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
+
     ENTER;
     PUSHSTACKi(PERLSI_MAGIC);
     PUSHMARK(SP);
@@ -1716,6 +1799,8 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
     dVAR; dSP;
     const char * const meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
 
+    PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
+
     ENTER;
     SAVETMPS;
     PUSHSTACKi(PERLSI_MAGIC);
@@ -1738,6 +1823,8 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 int
 Perl_magic_existspack(pTHX_ SV *sv, const MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_EXISTSPACK;
+
     return magic_methpack(sv,mg,"EXISTS");
 }
 
@@ -1749,6 +1836,8 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
     SV * const tied = SvTIED_obj((SV*)hv, mg);
     HV * const pkg = SvSTASH((SV*)SvRV(tied));
    
+    PERL_ARGS_ASSERT_MAGIC_SCALARPACK;
+
     if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) {
         SV *key;
         if (HvEITER_get(hv))
@@ -1786,6 +1875,9 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
     const I32 i = SvTRUE(sv);
     SV ** const svp = av_fetch(GvAV(gv),
 		     atoi(MgPV_nolen_const(mg)), FALSE);
+
+    PERL_ARGS_ASSERT_MAGIC_SETDBLINE;
+
     if (svp && SvIOKp(*svp)) {
 	OP * const o = INT2PTR(OP*,SvIVX(*svp));
 	if (o) {
@@ -1804,6 +1896,9 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
 {
     dVAR;
     const AV * const obj = (AV*)mg->mg_obj;
+
+    PERL_ARGS_ASSERT_MAGIC_GETARYLEN;
+
     if (obj) {
 	sv_setiv(sv, AvFILL(obj) + CopARYBASE_get(PL_curcop));
     } else {
@@ -1817,6 +1912,9 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     AV * const obj = (AV*)mg->mg_obj;
+
+    PERL_ARGS_ASSERT_MAGIC_SETARYLEN;
+
     if (obj) {
 	av_fill(obj, SvIV(sv) - CopARYBASE_get(PL_curcop));
     } else {
@@ -1831,7 +1929,10 @@ int
 Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_MAGIC_FREEARYLEN_P;
     PERL_UNUSED_ARG(sv);
+
     /* during global destruction, mg_obj may already have been freed */
     if (PL_in_clean_all)
 	return 0;
@@ -1854,6 +1955,8 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     SV* const lsv = LvTARG(sv);
+
+    PERL_ARGS_ASSERT_MAGIC_GETPOS;
     PERL_UNUSED_ARG(mg);
 
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
@@ -1880,6 +1983,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     STRLEN ulen = 0;
     MAGIC* found;
 
+    PERL_ARGS_ASSERT_MAGIC_SETPOS;
     PERL_UNUSED_ARG(mg);
 
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
@@ -1931,30 +2035,6 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 }
 
 int
-Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
-{
-    GV* gv;
-    PERL_UNUSED_ARG(mg);
-
-    Perl_croak(aTHX_ "Perl_magic_setglob is dead code?");
-
-    if (!SvOK(sv))
-	return 0;
-    if (isGV_with_GP(sv)) {
-	/* We're actually already a typeglob, so don't need the stuff below.
-	 */
-	return 0;
-    }
-    gv =  gv_fetchsv(sv, GV_ADD, SVt_PVGV);
-    if (sv == (SV*)gv)
-	return 0;
-    if (GvGP(sv))
-	gp_free((GV*)sv);
-    GvGP(sv) = gp_ref(GvGP(gv));
-    return 0;
-}
-
-int
 Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
     STRLEN len;
@@ -1962,6 +2042,8 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
     const char * const tmps = SvPV_const(lsv,len);
     I32 offs = LvTARGOFF(sv);
     I32 rem = LvTARGLEN(sv);
+
+    PERL_ARGS_ASSERT_MAGIC_GETSUBSTR;
     PERL_UNUSED_ARG(mg);
 
     if (SvUTF8(lsv))
@@ -1985,6 +2067,8 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
     SV * const lsv = LvTARG(sv);
     I32 lvoff = LvTARGOFF(sv);
     I32 lvlen = LvTARGLEN(sv);
+
+    PERL_ARGS_ASSERT_MAGIC_SETSUBSTR;
     PERL_UNUSED_ARG(mg);
 
     if (DO_UTF8(sv)) {
@@ -2015,7 +2099,10 @@ int
 Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_MAGIC_GETTAINT;
     PERL_UNUSED_ARG(sv);
+
     TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1));
     return 0;
 }
@@ -2024,7 +2111,10 @@ int
 Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_MAGIC_SETTAINT;
     PERL_UNUSED_ARG(sv);
+
     /* update taint status */
     if (PL_tainted)
 	mg->mg_len |= 1;
@@ -2037,6 +2127,8 @@ int
 Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
 {
     SV * const lsv = LvTARG(sv);
+
+    PERL_ARGS_ASSERT_MAGIC_GETVEC;
     PERL_UNUSED_ARG(mg);
 
     if (lsv)
@@ -2050,6 +2142,7 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_SETVEC;
     PERL_UNUSED_ARG(mg);
     do_vecset(sv);	/* XXX slurp this routine */
     return 0;
@@ -2060,6 +2153,9 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     SV *targ = NULL;
+
+    PERL_ARGS_ASSERT_MAGIC_GETDEFELEM;
+
     if (LvTARGLEN(sv)) {
 	if (mg->mg_obj) {
 	    SV * const ahv = LvTARG(sv);
@@ -2091,6 +2187,7 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_SETDEFELEM;
     PERL_UNUSED_ARG(mg);
     if (LvTARGLEN(sv))
 	vivify_defelem(sv);
@@ -2108,6 +2205,8 @@ Perl_vivify_defelem(pTHX_ SV *sv)
     MAGIC *mg;
     SV *value = NULL;
 
+    PERL_ARGS_ASSERT_VIVIFY_DEFELEM;
+
     if (!LvTARGLEN(sv) || !(mg = mg_find(sv, PERL_MAGIC_defelem)))
 	return;
     if (mg->mg_obj) {
@@ -2140,12 +2239,14 @@ Perl_vivify_defelem(pTHX_ SV *sv)
 int
 Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_KILLBACKREFS;
     return Perl_sv_kill_backrefs(aTHX_ sv, (AV*)mg->mg_obj);
 }
 
 int
 Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_SETMGLOB;
     PERL_UNUSED_CONTEXT;
     mg->mg_len = -1;
     SvSCREAM_off(sv);
@@ -2153,29 +2254,12 @@ Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
 }
 
 int
-Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg)
-{
-    PERL_UNUSED_ARG(mg);
-    sv_unmagic(sv, PERL_MAGIC_bm);
-    SvTAIL_off(sv);
-    SvVALID_off(sv);
-    return 0;
-}
-
-int
-Perl_magic_setfm(pTHX_ SV *sv, MAGIC *mg)
-{
-    PERL_UNUSED_ARG(mg);
-    sv_unmagic(sv, PERL_MAGIC_fm);
-    SvCOMPILED_off(sv);
-    return 0;
-}
-
-int
 Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
 {
     const struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
 
+    PERL_ARGS_ASSERT_MAGIC_SETUVAR;
+
     if (uf && uf->uf_set)
 	(*uf->uf_set)(aTHX_ uf->uf_index, sv);
     return 0;
@@ -2184,26 +2268,27 @@ Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
 {
-    PERL_UNUSED_ARG(mg);
-    sv_unmagic(sv, PERL_MAGIC_qr);
-    return 0;
-}
+    const char type = mg->mg_type;
 
-int
-Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg)
-{
-    dVAR;
-    regexp * const re = (regexp *)mg->mg_obj;
-    PERL_UNUSED_ARG(sv);
+    PERL_ARGS_ASSERT_MAGIC_SETREGEXP;
 
-    ReREFCNT_dec(re);
-    return 0;
+    if (type == PERL_MAGIC_qr) {
+    } else if (type == PERL_MAGIC_bm) {
+	SvTAIL_off(sv);
+	SvVALID_off(sv);
+    } else {
+	assert(type == PERL_MAGIC_fm);
+	SvCOMPILED_off(sv);
+    }
+    return sv_unmagic(sv, type);
 }
 
 #ifdef USE_LOCALE_COLLATE
 int
 Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_SETCOLLXFRM;
+
     /*
      * RenE<eacute> Descartes said "I think not."
      * and vanished with a faint plop.
@@ -2223,6 +2308,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_ARGS_ASSERT_MAGIC_SETUTF8;
     PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(sv);
     Safefree(mg->mg_ptr);	/* The mg_ptr holds the pos cache. */
@@ -2242,6 +2328,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     I32 i;
     STRLEN len;
 
+    PERL_ARGS_ASSERT_MAGIC_SET;
+
     switch (*mg->mg_ptr) {
     case '\015': /* $^MATCH */
       if (strEQ(remaining, "ATCH"))
@@ -2354,20 +2442,22 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 
 	    /* Opening for input is more common than opening for output, so
 	       ensure that hints for input are sooner on linked list.  */
-	    tmp = sv_2mortal(out ? newSVpvn(out + 1, start + len - out - 1)
-			     : newSVpvs(""));
-	    SvFLAGS(tmp) |= SvUTF8(sv);
+	    tmp = out ? newSVpvn_flags(out + 1, start + len - out - 1,
+				       SVs_TEMP | SvUTF8(sv))
+		: newSVpvn_flags("", 0, SVs_TEMP | SvUTF8(sv));
 
 	    tmp_he
 		= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash, 
-					 sv_2mortal(newSVpvs("open>")), tmp);
+					 newSVpvs_flags("open>", SVs_TEMP),
+					 tmp);
 
 	    /* The UTF-8 setting is carried over  */
 	    sv_setpvn(tmp, start, out ? (STRLEN)(out - start) : len);
 
 	    PL_compiling.cop_hints_hash
 		= Perl_refcounted_he_new(aTHX_ tmp_he,
-					 sv_2mortal(newSVpvs("open<")), tmp);
+					 newSVpvs_flags("open<", SVs_TEMP),
+					 tmp);
 	}
 	break;
     case '\020':	/* ^P */
@@ -2763,6 +2853,8 @@ I32
 Perl_whichsig(pTHX_ const char *sig)
 {
     register char* const* sigv;
+
+    PERL_ARGS_ASSERT_WHICHSIG;
     PERL_UNUSED_CONTEXT;
 
     for (sigv = (char* const*)PL_sig_name; *sigv; sigv++)
@@ -2876,7 +2968,7 @@ Perl_sighandler(int sig)
 #endif
 		   EXTEND(SP, 2);
 		   PUSHs((SV*)rv);
-		   PUSHs(newSVpv((char *)sip, sizeof(*sip)));
+		   mPUSHp((char *)sip, sizeof(*sip));
 	      }
 
 	 }
@@ -2986,6 +3078,8 @@ S_unwind_handler_stack(pTHX_ const void *p)
     dVAR;
     const U32 flags = *(const U32*)p;
 
+    PERL_ARGS_ASSERT_UNWIND_HANDLER_STACK;
+
     if (flags & 1)
 	PL_savestack_ix -= 5; /* Unprotect save in progress. */
 #if !defined(PERL_IMPLICIT_CONTEXT)
@@ -3009,7 +3103,9 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     SV *key = (mg->mg_len == HEf_SVKEY) ? (SV *)mg->mg_ptr
-	: sv_2mortal(newSVpvn(mg->mg_ptr, mg->mg_len));
+	: newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
+
+    PERL_ARGS_ASSERT_MAGIC_SETHINT;
 
     /* mg->mg_obj isn't being used.  If needed, it would be possible to store
        an alternative leaf in there, with PL_compiling.cop_hints being used if
@@ -3026,7 +3122,7 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
 }
 
 /*
-=for apidoc magic_sethint
+=for apidoc magic_clearhint
 
 Triggered by a delete from %^H, records the key to
 C<PL_compiling.cop_hints_hash>.
@@ -3037,6 +3133,8 @@ int
 Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_MAGIC_CLEARHINT;
     PERL_UNUSED_ARG(sv);
 
     assert(mg->mg_len == HEf_SVKEY);