X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=c8c935af90198626d2f295bc67afb6a9a1df494a;hb=ec2a1de722601129850327b38324ac227c58147a;hp=760517cd22493668e6cdde94be6b053ecc4de8a3;hpb=96a5add60f1f39d38341c09c11f0542e68f782b0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 760517c..c8c935a 100644
--- a/mg.c
+++ b/mg.c
@@ -152,7 +152,7 @@ Perl_mg_get(pTHX_ SV *sv)
        cause the SV's buffer to get stolen (and maybe other stuff).
        So restore it.
     */
-    sv_2mortal(SvREFCNT_inc(sv));
+    sv_2mortal(SvREFCNT_inc_simple_NN(sv));
     if (!was_temp) {
 	SvTEMP_off(sv);
     }
@@ -544,7 +544,8 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 {
-    PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg);
+    PERL_UNUSED_ARG(sv);
+    PERL_UNUSED_ARG(mg);
     Perl_croak(aTHX_ PL_no_modify);
     NORETURN_FUNCTION_END;
 }
@@ -716,7 +717,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	     }
 #elif defined(WIN32)
 	     {
-		  DWORD dwErr = GetLastError();
+		  const DWORD dwErr = GetLastError();
 		  sv_setnv(sv, (NV)dwErr);
 		  if (dwErr) {
 		       PerlProc_GetOSError(sv, dwErr);
@@ -790,11 +791,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		    ? (PL_taint_warn || PL_unsafe ? -1 : 1)
 		    : 0);
         break;
-    case '\025':		/* $^UNICODE, $^UTF8LOCALE */
+    case '\025':		/* $^UNICODE, $^UTF8LOCALE, $^UTF8CACHE */
 	if (strEQ(remaining, "NICODE"))
 	    sv_setuv(sv, (UV) PL_unicode);
 	else if (strEQ(remaining, "TF8LOCALE"))
 	    sv_setuv(sv, (UV) PL_utf8locale);
+	else if (strEQ(remaining, "TF8CACHE"))
+	    sv_setiv(sv, (IV) PL_utf8cache);
         break;
     case '\027':		/* ^W  & $^WARNING_BITS */
 	if (nextchar == '\0')
@@ -823,7 +826,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		}
 	    }
             else {
-	        sv_setsv(sv, PL_compiling.cop_warnings);
+	        sv_setpvn(sv, (char *) (PL_compiling.cop_warnings + 1),
+			  *PL_compiling.cop_warnings);
 	    }
 	    SvPOK_only(sv);
 	}
@@ -960,7 +964,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '/':
 	break;
     case '[':
-	WITH_THR(sv_setiv(sv, (IV)PL_curcop->cop_arybase));
+	WITH_THR(sv_setiv(sv, (IV)CopARYBASE_get(PL_curcop)));
 	break;
     case '|':
 	if (GvIOp(PL_defoutgv))
@@ -1039,8 +1043,8 @@ int
 Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
-    STRLEN len, klen;
-    const char *s = SvPV_const(sv,len);
+    STRLEN len = 0, klen;
+    const char *s = SvOK(sv) ? SvPV_const(sv,len) : "";
     const char * const ptr = MgPV_const(mg,klen);
     my_setenv(ptr, s);
 
@@ -1050,7 +1054,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
     if (!len) {
 	SV ** const valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE);
 	if (valp)
-	    s = SvPV_const(*valp, len);
+	    s = SvOK(*valp) ? SvPV_const(*valp, len) : "";
     }
 #endif
 
@@ -1098,7 +1102,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 		s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
 			     s, strend, ':', &i);
 		s++;
-		if (i >= sizeof tmpbuf   /* too long -- assume the worst */
+		if (i >= (I32)sizeof tmpbuf   /* too long -- assume the worst */
 		      || *tmpbuf != '/'
 		      || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) {
 		    MgTAINTEDDIR_on(mg);
@@ -1175,20 +1179,21 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
     	if(PL_psig_ptr[i])
     	    sv_setsv(sv,PL_psig_ptr[i]);
     	else {
-    	    Sighandler_t sigstate;
-    	    sigstate = rsignal_state(i);
+	    Sighandler_t sigstate = rsignal_state(i);
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
-    	    if (PL_sig_handlers_initted && PL_sig_ignoring[i]) sigstate = SIG_IGN;
+	    if (PL_sig_handlers_initted && PL_sig_ignoring[i])
+		sigstate = SIG_IGN;
 #endif
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
-    	    if (PL_sig_handlers_initted && PL_sig_defaulting[i]) sigstate = SIG_DFL;
+	    if (PL_sig_handlers_initted && PL_sig_defaulting[i])
+		sigstate = SIG_DFL;
 #endif
     	    /* cache state so we don't fetch it again */
     	    if(sigstate == (Sighandler_t) SIG_IGN)
     	    	sv_setpv(sv,"IGNORE");
     	    else
     	    	sv_setsv(sv,&PL_sv_undef);
-    	    PL_psig_ptr[i] = SvREFCNT_inc(sv);
+	    PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv);
     	    SvTEMP_off(sv);
     	}
     }
@@ -1400,7 +1405,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
 	SvREFCNT_dec(PL_psig_name[i]);
 	to_dec = PL_psig_ptr[i];
-	PL_psig_ptr[i] = SvREFCNT_inc(sv);
+	PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv);
 	SvTEMP_off(sv); /* Make sure it doesn't go away on us */
 	PL_psig_name[i] = newSVpvn(s, len);
 	SvREADONLY_on(PL_psig_name[i]);
@@ -1413,7 +1418,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
 	}
 	else
-	    *svp = SvREFCNT_inc(sv);
+	    *svp = SvREFCNT_inc_simple_NN(sv);
 	if(to_dec)
 	    SvREFCNT_dec(to_dec);
 	return 0;
@@ -1451,7 +1456,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 	if (i)
 	    (void)rsignal(i, PL_csighandlerp);
 	else
-	    *svp = SvREFCNT_inc(sv);
+	    *svp = SvREFCNT_inc_simple_NN(sv);
     }
 #ifdef HAS_SIGPROCMASK
     if(i)
@@ -1663,7 +1668,7 @@ SV *
 Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 {
     dVAR; dSP;
-    SV *retval = &PL_sv_undef;
+    SV *retval;
     SV * const tied = SvTIED_obj((SV*)hv, mg);
     HV * const pkg = SvSTASH((SV*)SvRV(tied));
    
@@ -1689,6 +1694,8 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 
     if (call_method("SCALAR", G_SCALAR))
         retval = *PL_stack_sp--; 
+    else
+	retval = &PL_sv_undef;
     POPSTACK;
     LEAVE;
     return retval;
@@ -1721,7 +1728,7 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
     dVAR;
     const AV * const obj = (AV*)mg->mg_obj;
     if (obj) {
-	sv_setiv(sv, AvFILL(obj) + PL_curcop->cop_arybase);
+	sv_setiv(sv, AvFILL(obj) + CopARYBASE_get(PL_curcop));
     } else {
 	SvOK_off(sv);
     }
@@ -1734,7 +1741,7 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
     dVAR;
     AV * const obj = (AV*)mg->mg_obj;
     if (obj) {
-	av_fill(obj, SvIV(sv) - PL_curcop->cop_arybase);
+	av_fill(obj, SvIV(sv) - CopARYBASE_get(PL_curcop));
     } else {
 	if (ckWARN(WARN_MISC))
 	    Perl_warner(aTHX_ packWARN(WARN_MISC),
@@ -1770,14 +1777,15 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     SV* const lsv = LvTARG(sv);
+    PERL_UNUSED_ARG(mg);
 
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
-	mg = mg_find(lsv, PERL_MAGIC_regex_global);
-	if (mg && mg->mg_len >= 0) {
-	    I32 i = mg->mg_len;
+	MAGIC * const found = mg_find(lsv, PERL_MAGIC_regex_global);
+	if (found && found->mg_len >= 0) {
+	    I32 i = found->mg_len;
 	    if (DO_UTF8(lsv))
 		sv_pos_b2u(lsv, &i);
-	    sv_setiv(sv, i + PL_curcop->cop_arybase);
+	    sv_setiv(sv, i + CopARYBASE_get(PL_curcop));
 	    return 0;
 	}
     }
@@ -1793,24 +1801,31 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     SSize_t pos;
     STRLEN len;
     STRLEN ulen = 0;
+    MAGIC *found;
 
-    mg = 0;
+    PERL_UNUSED_ARG(mg);
 
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
-	mg = mg_find(lsv, PERL_MAGIC_regex_global);
-    if (!mg) {
+	found = mg_find(lsv, PERL_MAGIC_regex_global);
+    else
+	found = NULL;
+    if (!found) {
 	if (!SvOK(sv))
 	    return 0;
-	sv_magic(lsv, NULL, PERL_MAGIC_regex_global, NULL, 0);
-	mg = mg_find(lsv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+    if (SvIsCOW(lsv))
+        sv_force_normal_flags(lsv, 0);
+#endif
+	found = sv_magicext(lsv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+			 NULL, 0);
     }
     else if (!SvOK(sv)) {
-	mg->mg_len = -1;
+	found->mg_len = -1;
 	return 0;
     }
     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
 
-    pos = SvIV(sv) - PL_curcop->cop_arybase;
+    pos = SvIV(sv) - CopARYBASE_get(PL_curcop);
 
     if (DO_UTF8(lsv)) {
 	ulen = sv_len_utf8(lsv);
@@ -1832,8 +1847,8 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 	pos = p;
     }
 
-    mg->mg_len = pos;
-    mg->mg_flags &= ~MGf_MINMATCH;
+    found->mg_len = pos;
+    found->mg_flags &= ~MGf_MINMATCH;
 
     return 0;
 }
@@ -1888,7 +1903,7 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     STRLEN len;
-    const char *tmps = SvPV_const(sv, len);
+    const char * const tmps = SvPV_const(sv, len);
     SV * const lsv = LvTARG(sv);
     I32 lvoff = LvTARGOFF(sv);
     I32 lvlen = LvTARGLEN(sv);
@@ -1902,11 +1917,12 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 	SvUTF8_on(lsv);
     }
     else if (lsv && SvUTF8(lsv)) {
+	const char *utf8;
 	sv_pos_u2b(lsv, &lvoff, &lvlen);
 	LvTARGLEN(sv) = len;
-	tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
-	sv_insert(lsv, lvoff, lvlen, tmps, len);
-	Safefree(tmps);
+	utf8 = (char*)bytes_to_utf8((U8*)tmps, &len);
+	sv_insert(lsv, lvoff, lvlen, utf8, len);
+	Safefree(utf8);
     }
     else {
 	sv_insert(lsv, lvoff, lvlen, tmps, len);
@@ -1980,10 +1996,10 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 	    if ((I32)LvTARGOFF(sv) <= AvFILL(av))
 		targ = AvARRAY(av)[LvTARGOFF(sv)];
 	}
-	if (targ && targ != &PL_sv_undef) {
+	if (targ && (targ != &PL_sv_undef)) {
 	    /* somebody else defined it for us */
 	    SvREFCNT_dec(LvTARG(sv));
-	    LvTARG(sv) = SvREFCNT_inc(targ);
+	    LvTARG(sv) = SvREFCNT_inc_simple_NN(targ);
 	    LvTARGLEN(sv) = 0;
 	    SvREFCNT_dec(mg->mg_obj);
 	    mg->mg_obj = NULL;
@@ -2031,12 +2047,12 @@ Perl_vivify_defelem(pTHX_ SV *sv)
 	if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av))
 	    LvTARG(sv) = NULL;	/* array can't be extended */
 	else {
-	    SV** const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
+	    SV* const * const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
 	    if (!svp || (value = *svp) == &PL_sv_undef)
 		Perl_croak(aTHX_ PL_no_aelem, (I32)LvTARGOFF(sv));
 	}
     }
-    (void)SvREFCNT_inc(value);
+    SvREFCNT_inc_simple_void(value);
     SvREFCNT_dec(LvTARG(sv));
     LvTARG(sv) = value;
     LvTARGLEN(sv) = 0;
@@ -2133,7 +2149,7 @@ Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
     PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(sv);
     Safefree(mg->mg_ptr);	/* The mg_ptr holds the pos cache. */
-    mg->mg_ptr = 0;
+    mg->mg_ptr = NULL;
     mg->mg_len = -1;		/* The mg_len holds the len cache. */
     return 0;
 }
@@ -2150,7 +2166,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	sv_setsv(PL_bodytarget, sv);
 	break;
     case '\003':	/* ^C */
-	PL_minus_c = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	PL_minus_c = (bool)SvIV(sv);
 	break;
 
     case '\004':	/* ^D */
@@ -2159,25 +2175,25 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
 	DEBUG_x(dump_all());
 #else
-	PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
+	PL_debug = (SvIV(sv)) | DEBUG_TOP_FLAG;
 #endif
 	break;
     case '\005':  /* ^E */
 	if (*(mg->mg_ptr+1) == '\0') {
 #ifdef MACOS_TRADITIONAL
-	    gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	    gMacPerl_OSErr = SvIV(sv);
 #else
 #  ifdef VMS
-	    set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	    set_vaxc_errno(SvIV(sv));
 #  else
 #    ifdef WIN32
 	    SetLastError( SvIV(sv) );
 #    else
 #      ifdef OS2
-	    os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	    os2_setsyserrno(SvIV(sv));
 #      else
 	    /* will anyone ever use this? */
-	    SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
+	    SETERRNO(SvIV(sv), 4);
 #      endif
 #    endif
 #  endif
@@ -2195,10 +2211,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	}
 	break;
     case '\006':	/* ^F */
-	PL_maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_maxsysfd = SvIV(sv);
 	break;
     case '\010':	/* ^H */
-	PL_hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_hints = SvIV(sv);
 	break;
     case '\011':	/* ^I */ /* NOT \t in EBCDIC */
 	Safefree(PL_inplace);
@@ -2221,7 +2237,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	}
 	break;
     case '\020':	/* ^P */
-	PL_perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_perldb = SvIV(sv);
 	if (PL_perldb && !PL_DBsingle)
 	    init_debugger();
 	break;
@@ -2229,13 +2245,18 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #ifdef BIG_TIME
 	PL_basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
 #else
-	PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	PL_basetime = (Time_t)SvIV(sv);
 #endif
 	break;
+    case '\025':	/* ^UTF8CACHE */
+	 if (strEQ(mg->mg_ptr+1, "TF8CACHE")) {
+	     PL_utf8cache = (signed char) sv_2iv(sv);
+	 }
+	 break;
     case '\027':	/* ^W & $^WARNING_BITS */
 	if (*(mg->mg_ptr+1) == '\0') {
 	    if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
-	        i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	        i = SvIV(sv);
 	        PL_dowarn = (PL_dowarn & ~G_WARN_ON)
 		    		| (i ? G_WARN_ON : G_WARN_OFF) ;
 	    }
@@ -2258,15 +2279,20 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 		    }
 		    if (!accumulate)
 	                PL_compiling.cop_warnings = pWARN_NONE;
-		    else if (isWARN_on(sv, WARN_ALL) && !any_fatals) {
+		    /* Yuck. I can't see how to abstract this:  */
+		    else if (isWARN_on(((STRLEN *)SvPV_nolen_const(sv)) - 1,
+				       WARN_ALL) && !any_fatals) {
 	                PL_compiling.cop_warnings = pWARN_ALL;
 	                PL_dowarn |= G_WARN_ONCE ;
 	            }
                     else {
-	                if (specialWARN(PL_compiling.cop_warnings))
-		            PL_compiling.cop_warnings = newSVsv(sv) ;
-	                else
-	                    sv_setsv(PL_compiling.cop_warnings, sv);
+			STRLEN len;
+			const char *const p = SvPV_const(sv, len);
+
+			PL_compiling.cop_warnings
+			    = Perl_new_warnings_bitfield(aTHX_ PL_compiling.cop_warnings,
+							 p, len);
+
 	                if (isWARN_on(PL_compiling.cop_warnings, WARN_ONCE))
 	                    PL_dowarn |= G_WARN_ONCE ;
 	            }
@@ -2294,22 +2320,22 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	IoFMT_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
 	break;
     case '=':
-	IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv));
 	break;
     case '-':
-	IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv));
 	if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
 	    IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
 	break;
     case '%':
-	IoPAGE(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv));
 	break;
     case '|':
 	{
 	    IO * const io = GvIOp(PL_defoutgv);
 	    if(!io)
 	      break;
-	    if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0)
+	    if ((SvIV(sv)) == 0)
 		IoFLAGS(io) &= ~IOf_FLUSH;
 	    else {
 		if (!(IoFLAGS(io) & IOf_FLUSH)) {
@@ -2346,7 +2372,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	}
 	break;
     case '[':
-	PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	CopARYBASE_set(&PL_compiling, SvIV(sv));
 	break;
     case '?':
 #ifdef COMPLEX_STATUS
@@ -2361,7 +2387,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    STATUS_NATIVE_CHILD_SET((U32)SvIV(sv));
 	else
 #endif
-	    STATUS_UNIX_EXIT_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	    STATUS_UNIX_EXIT_SET(SvIV(sv));
 	break;
     case '!':
         {
@@ -2375,7 +2401,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	}
 	break;
     case '<':
-	PL_uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_uid = SvIV(sv);
 	if (PL_delaymagic) {
 	    PL_delaymagic |= DM_RUID;
 	    break;				/* don't do magic till later */
@@ -2407,7 +2433,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
 	break;
     case '>':
-	PL_euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_euid = SvIV(sv);
 	if (PL_delaymagic) {
 	    PL_delaymagic |= DM_EUID;
 	    break;				/* don't do magic till later */
@@ -2434,7 +2460,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
 	break;
     case '(':
-	PL_gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_gid = SvIV(sv);
 	if (PL_delaymagic) {
 	    PL_delaymagic |= DM_RGID;
 	    break;				/* don't do magic till later */
@@ -2488,7 +2514,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                 Safefree(gary);
 	}
 #else  /* HAS_SETGROUPS */
-	PL_egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_egid = SvIV(sv);
 #endif /* HAS_SETGROUPS */
 	if (PL_delaymagic) {
 	    PL_delaymagic |= DM_EGID;
@@ -2666,7 +2692,7 @@ Perl_sighandler(int sig)
     }
 
     if(PL_psig_name[sig]) {
-    	sv = SvREFCNT_inc(PL_psig_name[sig]);
+	sv = SvREFCNT_inc_NN(PL_psig_name[sig]);
 	flags |= 64;
 #if !defined(PERL_IMPLICIT_CONTEXT)
 	PL_sig_sv = sv;
@@ -2826,6 +2852,58 @@ S_unwind_handler_stack(pTHX_ const void *p)
 }
 
 /*
+=for apidoc magic_sethint
+
+Triggered by a store to %^H, records the key/value pair to
+C<PL_compiling.cop_hints>.  It is assumed that hints aren't storing anything
+that would need a deep copy.  Maybe we should warn if we find a reference.
+
+=cut
+*/
+int
+Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
+{
+    dVAR;
+    assert(mg->mg_len == HEf_SVKEY);
+
+    /* 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
+       it's NULL. If needed for threads, the alternative could lock a mutex,
+       or take other more complex action.  */
+
+    /* Something changed in %^H, so it will need to be restored on scope exit.
+       Doing this here saves a lot of doing it manually in perl code (and
+       forgetting to do it, and consequent subtle errors.  */
+    PL_hints |= HINT_LOCALIZE_HH;
+    PL_compiling.cop_hints
+	= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints,
+				 (SV *)mg->mg_ptr, sv);
+    return 0;
+}
+
+/*
+=for apidoc magic_sethint
+
+Triggered by a delete from %^H, records the key to C<PL_compiling.cop_hints>.
+
+=cut
+*/
+int
+Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
+{
+    dVAR;
+    assert(mg->mg_len == HEf_SVKEY);
+
+    PERL_UNUSED_ARG(sv);
+
+    PL_hints |= HINT_LOCALIZE_HH;
+    PL_compiling.cop_hints
+	= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints,
+				 (SV *)mg->mg_ptr, &PL_sv_placeholder);
+    return 0;
+}
+
+/*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4