eliminate PL_regprecomp, PL_regprogram, PL_regnpar and PL_regdata

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index fa670b1..acadce7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1089,7 +1089,7 @@ S_more_bodies (pTHX_ svtype sv_type)
        void ** const r3wt = &PL_body_roots[sv_type]; \
        LOCK_SV_MUTEX; \
        xpv = *((void **)(r3wt)) \
-         ? *((void **)(r3wt)) : S_more_bodies(aTHX_ sv_type); \
+         ? *((void **)(r3wt)) : more_bodies(sv_type); \
        *(r3wt) = *(void**)(xpv); \
        UNLOCK_SV_MUTEX; \
     } STMT_END
@@ -1319,7 +1319,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
            int length = old_type_details->copy;
 
            if (new_type_details->offset > old_type_details->offset) {
-               int difference
+               const int difference
                    = new_type_details->offset - old_type_details->offset;
                offset += difference;
                length -= difference;
@@ -3445,7 +3445,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 
     case SVt_PVGV:
        if (dtype <= SVt_PVGV) {
-           S_glob_assign_glob(aTHX_ dstr, sstr, dtype);
+           glob_assign_glob(dstr, sstr, dtype);
            return;
        }
        /*FALLTHROUGH*/
@@ -3458,7 +3458,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            if ((int)SvTYPE(sstr) != stype) {
                stype = SvTYPE(sstr);
                if (stype == SVt_PVGV && dtype <= SVt_PVGV) {
-                   S_glob_assign_glob(aTHX_ dstr, sstr, dtype);
+                   glob_assign_glob(dstr, sstr, dtype);
                    return;
                }
            }
@@ -3486,13 +3486,13 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                GvMULTI_on(dstr);
                return;
            }
-           S_glob_assign_glob(aTHX_ dstr, sstr, dtype);
+           glob_assign_glob(dstr, sstr, dtype);
            return;
        }
 
        if (dtype >= SVt_PV) {
            if (dtype == SVt_PVGV) {
-               S_glob_assign_ref(aTHX_ dstr, sstr);
+               glob_assign_ref(dstr, sstr);
                return;
            }
            if (SvPVX_const(dstr)) {
@@ -4489,6 +4489,8 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     case PERL_MAGIC_qr:
        vtable = &PL_vtbl_regexp;
        break;
+    case PERL_MAGIC_hints:
+       /* As this vtable is all NULL, we can reuse it.  */
     case PERL_MAGIC_sig:
        vtable = &PL_vtbl_sig;
        break;
@@ -4528,6 +4530,9 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     case PERL_MAGIC_backref:
        vtable = &PL_vtbl_backref;
        break;
+    case PERL_MAGIC_hintselem:
+       vtable = &PL_vtbl_hintselem;
+       break;
     case PERL_MAGIC_ext:
        /* Reserved for use by extensions not perl internals.           */
        /* Useful for attaching extension internal data to perl vars.   */
@@ -5339,6 +5344,8 @@ S_sv_pos_u2b_forwards(pTHX_ const U8 *const start, const U8 *const send,
 {
     const U8 *s = start;
 
+    PERL_UNUSED_CONTEXT;
+
     while (s < send && uoffset--)
        s += UTF8SKIP(s);
     if (s > send) {
@@ -5791,7 +5798,7 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
     if (SvMAGICAL(sv) && !SvREADONLY(sv) && PL_utf8cache
        && (mg = mg_find(sv, PERL_MAGIC_utf8))) {
        if (mg->mg_ptr) {
-           STRLEN *cache = (STRLEN *) mg->mg_ptr;
+           STRLEN * const cache = (STRLEN *) mg->mg_ptr;
            if (cache[1] == byte) {
                /* An exact match. */
                *offsetp = cache[0];
@@ -7681,9 +7688,11 @@ Perl_newSVrv(pTHX_ SV *rv, const char *classname)
        sv_clear(rv);
        SvFLAGS(rv) = 0;
        SvREFCNT(rv) = refcnt;
-    }
 
-    if (SvTYPE(rv) < SVt_RV)
+       sv_upgrade(rv, SVt_RV);
+    } else if (SvROK(rv)) {
+       SvREFCNT_dec(SvRV(rv));
+    } else if (SvTYPE(rv) < SVt_RV)
        sv_upgrade(rv, SVt_RV);
     else if (SvTYPE(rv) > SVt_RV) {
        SvPV_free(rv);
@@ -9375,6 +9384,7 @@ ptr_table_* functions.
 
 #if defined(USE_ITHREADS)
 
+/* XXX Remove this so it doesn't have to go thru the macro and return for nothing */
 #ifndef GpREFCNT_inc
 #  define GpREFCNT_inc(gp)     ((gp) ? (++(gp)->gp_refcnt, (gp)) : (GP*)NULL)
 #endif
@@ -9687,7 +9697,7 @@ S_ptr_table_find(PTR_TBL_t *tbl, const void *sv) {
        if (tblent->oldval == sv)
            return tblent;
     }
-    return 0;
+    return NULL;
 }
 
 void *
@@ -9695,7 +9705,7 @@ Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv)
 {
     PTR_TBL_ENT_t const *const tblent = ptr_table_find(tbl, sv);
     PERL_UNUSED_CONTEXT;
-    return tblent ? tblent->newval : (void *) 0;
+    return tblent ? tblent->newval : NULL;
 }
 
 /* add a new entry to a pointer-mapping table */
@@ -10570,6 +10580,12 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
        case SAVEt_HINTS:
            i = POPINT(ss,ix);
            TOPINT(nss,ix) = i;
+           ptr = POPPTR(ss,ix);
+           TOPPTR(nss,ix) = Perl_refcounted_he_dup(aTHX_ ptr, param);
+           if (i & HINT_LOCALIZE_HH) {
+               hv = (HV*)POPPTR(ss,ix);
+               TOPPTR(nss,ix) = hv_dup_inc(hv, param);
+           }
            break;
        case SAVEt_COMPPAD:
            av = (AV*)POPPTR(ss,ix);
@@ -10854,6 +10870,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings, param);
     if (!specialCopIO(PL_compiling.cop_io))
        PL_compiling.cop_io = sv_dup_inc(PL_compiling.cop_io, param);
+    PL_compiling.cop_hints
+       = Perl_refcounted_he_dup(aTHX_ PL_compiling.cop_hints, param);
     PL_curcop          = (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
 
     /* pseudo environmental stuff */
@@ -11414,8 +11432,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_watchok         = NULL;
 
     PL_regdummy                = proto_perl->Tregdummy;
-    PL_regprecomp      = NULL;
-    PL_regnpar         = 0;
     PL_regsize         = 0;
     PL_colorset                = 0;            /* reinits PL_colors[] */
     /*PL_colors[6]     = {0,0,0,0,0,0};*/
@@ -11429,12 +11445,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_regtill         = NULL;
     PL_reg_start_tmp   = (char**)NULL;
     PL_reg_start_tmpl  = 0;
-    PL_regdata         = (struct reg_data*)NULL;
     PL_bostr           = NULL;
     PL_reg_flags       = 0;
     PL_reg_eval_set    = 0;
     PL_regnarrate      = 0;
-    PL_regprogram      = (regnode*)NULL;
     PL_regindent       = 0;
     PL_reg_call_cc     = (struct re_cc_state*)NULL;
     PL_reg_re          = (regexp*)NULL;
@@ -11464,6 +11478,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_reginterp_cnt   = 0;
     PL_reg_starttry    = 0;
+    PL_regmatch_slab   = NULL;
 
     /* Pluggable optimizer */
     PL_peepp           = proto_perl->Tpeepp;
@@ -11816,7 +11831,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 
        /* attempt to find a match within the aggregate */
        if (hash) {
-           keysv = S_find_hash_subscript(aTHX_ (HV*)sv, uninit_sv);
+           keysv = find_hash_subscript((HV*)sv, uninit_sv);
            if (keysv)
                subscript_type = FUV_SUBSCRIPT_HASH;
        }
@@ -11937,13 +11952,13 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
            /* index is an expression;
             * attempt to find a match within the aggregate */
            if (obase->op_type == OP_HELEM) {
-               SV * const keysv = S_find_hash_subscript(aTHX_ (HV*)sv, uninit_sv);
+               SV * const keysv = find_hash_subscript((HV*)sv, uninit_sv);
                if (keysv)
                    return varname(gv, '%', o->op_targ,
                                                keysv, 0, FUV_SUBSCRIPT_HASH);
            }
            else {
-               const I32 index = S_find_array_subscript(aTHX_ (AV*)sv, uninit_sv);
+               const I32 index = find_array_subscript((AV*)sv, uninit_sv);
                if (index >= 0)
                    return varname(gv, '@', o->op_targ,
                                        NULL, index, FUV_SUBSCRIPT_ARRAY);