Re: [PATCH] More regex optimisations and debug enhancements (including Andys stuff...

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index 1fb948b..d6e307d 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1066,8 +1066,9 @@ S_more_bodies (pTHX_ svtype sv_type)
     /* computed count doesnt reflect the 1st slot reservation */
     DEBUG_m(PerlIO_printf(Perl_debug_log,
                          "arena %p end %p arena-size %d type %d size %d ct %d\n",
-                         start, end, bdp->arena_size, sv_type, body_size,
-                         bdp->arena_size / body_size));
+                         start, end,
+                         (int)bdp->arena_size, sv_type, (int)body_size,
+                         (int)bdp->arena_size / (int)body_size));
 
     *root = (void *)start;
 
@@ -1752,7 +1753,9 @@ S_glob_2pv(pTHX_ GV * const gv, STRLEN * const len)
     SvFLAGS(gv) |= wasfake;
 
     assert(SvPOK(buffer));
-    *len = SvCUR(buffer);
+    if (len) {
+       *len = SvCUR(buffer);
+    }
     return SvPVX(buffer);
 }
 
@@ -2658,13 +2661,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 
            if (SvIOKp(sv)) {
                len = SvIsUV(sv)
-#ifdef USE_SNPRINTF
-                   ? snprintf(tbuf, sizeof(tbuf), "%"UVuf, (UV)SvUVX(sv))
-                   : snprintf(tbuf, sizeof(tbuf), "%"IVdf, (IV)SvIVX(sv));
-#else
-                   ? my_sprintf(tbuf, "%"UVuf, (UV)SvUVX(sv))
-                   : my_sprintf(tbuf, "%"IVdf, (IV)SvIVX(sv));
-#endif /* #ifdef USE_SNPRINTF */
+                   ? my_snprintf(tbuf, sizeof(tbuf), "%"UVuf, (UV)SvUVX(sv))
+                   : my_snprintf(tbuf, sizeof(tbuf), "%"IVdf, (IV)SvIVX(sv));
            } else {
                Gconvert(SvNVX(sv), NV_DIG, 0, tbuf);
                len = strlen(tbuf);
@@ -3098,13 +3096,13 @@ flag off so that it looks like octets again.
 void
 Perl_sv_utf8_encode(pTHX_ register SV *sv)
 {
-    (void) sv_utf8_upgrade(sv);
     if (SvIsCOW(sv)) {
         sv_force_normal_flags(sv, 0);
     }
     if (SvREADONLY(sv)) {
        Perl_croak(aTHX_ PL_no_modify);
     }
+    (void) sv_utf8_upgrade(sv);
     SvUTF8_off(sv);
 }
 
@@ -3678,7 +3676,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        SvFLAGS(dstr) |= sflags & (SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK|SVf_UTF8
                                   |SVf_AMAGIC);
        {
-           const MAGIC * const smg = SvVOK(sstr);
+           const MAGIC * const smg = SvVSTRING_mg(sstr);
            if (smg) {
                sv_magic(dstr, NULL, PERL_MAGIC_vstring,
                         smg->mg_ptr, smg->mg_len);
@@ -6981,12 +6979,15 @@ Perl_newSVhek(pTHX_ const HEK *hek)
            SvUTF8_on (sv);
            Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
            return sv;
-       } else if (flags & HVhek_REHASH) {
+       } else if (flags & (HVhek_REHASH|HVhek_UNSHARED)) {
            /* We don't have a pointer to the hv, so we have to replicate the
               flag into every HEK. This hv is using custom a hasing
               algorithm. Hence we can't return a shared string scalar, as
               that would contain the (wrong) hash value, and might get passed
-              into an hv routine with a regular hash  */
+              into an hv routine with a regular hash.
+              Similarly, a hash that isn't using shared hash keys has to have
+              the flag in every key so that we know not to try to call
+              share_hek_kek on it.  */
 
            SV * const sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
            if (HEK_UTF8(hek))
@@ -9265,13 +9266,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                 * --jhi */
 #if defined(HAS_LONG_DOUBLE)
                elen = ((intsize == 'q')
-# ifdef USE_SNPRINTF
-                       ? snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
-                       : snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)nv));
-# else
-                       ? my_sprintf(PL_efloatbuf, ptr, nv)
-                       : my_sprintf(PL_efloatbuf, ptr, (double)nv));
-# endif /* #ifdef USE_SNPRINTF */
+                       ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
+                       : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)nv));
 #else
                elen = my_sprintf(PL_efloatbuf, ptr, nv);
 #endif
@@ -10039,7 +10035,6 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
               missing by always going for the destination.
               FIXME - instrument and check that assumption  */
            if (sv_type >= SVt_PVMG) {
-               HV *ourstash;
                if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
                    OURSTASH_set(dstr, hv_dup_inc(OURSTASH(dstr), param));
                } else if (SvMAGIC(dstr))
@@ -10276,6 +10271,8 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                ncx->blk_sub.hasargs    = cx->blk_sub.hasargs;
                ncx->blk_sub.lval       = cx->blk_sub.lval;
                ncx->blk_sub.retop      = cx->blk_sub.retop;
+               ncx->blk_sub.oldcomppad = (PAD*)ptr_table_fetch(PL_ptr_table,
+                                          cx->blk_sub.oldcomppad);
                break;
            case CXt_EVAL:
                ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval;
@@ -10966,11 +10963,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
     PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
-    if (!specialCopIO(PL_compiling.cop_io))
-       PL_compiling.cop_io = sv_dup_inc(PL_compiling.cop_io, param);
-    if (PL_compiling.cop_hints) {
+    if (PL_compiling.cop_hints_hash) {
        HINTS_REFCNT_LOCK;
-       PL_compiling.cop_hints->refcounted_he_refcnt++;
+       PL_compiling.cop_hints_hash->refcounted_he_refcnt++;
        HINTS_REFCNT_UNLOCK;
     }
     PL_curcop          = (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
@@ -11751,16 +11746,17 @@ STATIC I32
 S_find_array_subscript(pTHX_ AV *av, SV* val)
 {
     dVAR;
-    SV** svp;
-    I32 i;
     if (!av || SvMAGICAL(av) || !AvARRAY(av) ||
                        (AvFILLp(av) > FUV_MAX_SEARCH_SIZE))
        return -1;
 
-    svp = AvARRAY(av);
-    for (i=AvFILLp(av); i>=0; i--) {
-       if (svp[i] == val && svp[i] != &PL_sv_undef)
-           return i;
+    if (val != &PL_sv_undef) {
+       SV ** const svp = AvARRAY(av);
+       I32 i;
+
+       for (i=AvFILLp(av); i>=0; i--)
+           if (svp[i] == val)
+               return i;
     }
     return -1;
 }