Abstract all the accesses to cop_arybase (apart from ByteLoader)
[p5sagit/p5-mst-13.2.git] / mg.c
diff --git a/mg.c b/mg.c
index 2de5a86..91bf38c 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -100,7 +100,7 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
 
     SvMAGICAL_off(sv);
     SvREADONLY_off(sv);
-    SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+    SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 }
 
 /*
@@ -115,6 +115,7 @@ void
 Perl_mg_magical(pTHX_ SV *sv)
 {
     const MAGIC* mg;
+    PERL_UNUSED_CONTEXT;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        const MGVTBL* const vtbl = mg->mg_virtual;
        if (vtbl) {
@@ -151,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(sv));
     if (!was_temp) {
        SvTEMP_off(sv);
     }
@@ -347,6 +348,7 @@ Finds the magic pointer for type matching the SV.  See C<sv_magic>.
 MAGIC*
 Perl_mg_find(pTHX_ const SV *sv, int type)
 {
+    PERL_UNUSED_CONTEXT;
     if (sv) {
         MAGIC *mg;
         for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
@@ -354,7 +356,7 @@ Perl_mg_find(pTHX_ const SV *sv, int type)
                 return mg;
         }
     }
-    return 0;
+    return NULL;
 }
 
 /*
@@ -542,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;
 }
@@ -714,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);
@@ -788,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')
@@ -843,8 +848,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            {
                i = t1 - s1;
                s = rx->subbeg + s1;
-               if (!rx->subbeg)
-                   break;
+               assert(rx->subbeg);
 
              getrx:
                if (i >= 0) {
@@ -959,7 +963,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))
@@ -1187,7 +1191,7 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
                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(sv);
            SvTEMP_off(sv);
        }
     }
@@ -1399,7 +1403,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(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]);
@@ -1412,7 +1416,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;
@@ -1450,7 +1454,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(sv);
     }
 #ifdef HAS_SIGPROCMASK
     if(i)
@@ -1720,7 +1724,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);
     }
@@ -1733,7 +1737,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),
@@ -1776,7 +1780,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
            I32 i = mg->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;
        }
     }
@@ -1800,8 +1804,12 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     if (!mg) {
        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
+       mg = sv_magicext(lsv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+                        NULL, 0);
     }
     else if (!SvOK(sv)) {
        mg->mg_len = -1;
@@ -1809,7 +1817,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     }
     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);
@@ -1838,20 +1846,6 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 }
 
 int
-Perl_magic_getglob(pTHX_ SV *sv, MAGIC *mg)
-{
-    PERL_UNUSED_ARG(mg);
-    if (SvFAKE(sv)) {                  /* FAKE globs can get coerced */
-       SvFAKE_off(sv);
-       gv_efullname3(sv,((GV*)sv), "*");
-       SvFAKE_on(sv);
-    }
-    else
-       gv_efullname3(sv,((GV*)sv), "*");       /* a gv value, be nice */
-    return 0;
-}
-
-int
 Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 {
     GV* gv;
@@ -1859,6 +1853,12 @@ Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 
     if (!SvOK(sv))
        return 0;
+    if (SvFLAGS(sv) & SVp_SCREAM
+       && (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVGV)) {
+       /* 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;
@@ -1990,7 +1990,7 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
        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;
@@ -2038,12 +2038,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;
@@ -2061,6 +2061,7 @@ Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_CONTEXT;
     mg->mg_len = -1;
     SvSCREAM_off(sv);
     return 0;
@@ -2121,6 +2122,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
      * RenE<eacute> Descartes said "I think not."
      * and vanished with a faint plop.
      */
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(sv);
     if (mg->mg_ptr) {
        Safefree(mg->mg_ptr);
@@ -2135,6 +2137,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
 int
 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;
@@ -2236,6 +2239,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(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)) {
@@ -2350,7 +2358,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, SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '?':
 #ifdef COMPLEX_STATUS
@@ -2592,6 +2600,7 @@ I32
 Perl_whichsig(pTHX_ const char *sig)
 {
     register char* const* sigv;
+    PERL_UNUSED_CONTEXT;
 
     for (sigv = (char* const*)PL_sig_name; *sigv; sigv++)
        if (strEQ(sig,*sigv))
@@ -2669,7 +2678,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;
@@ -2829,6 +2838,56 @@ 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, newSVsv(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);
+
+    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