Using gv_stashsv() and sv_setsv() in Perl_package reduces source and

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 722867a..14f1a7d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -438,11 +438,18 @@ Perl_op_clear(pTHX_ OP *o)
        /* FALL THROUGH */
     case OP_TRANS:
        if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
+#ifdef USE_ITHREADS
+           if (cPADOPo->op_padix > 0) {
+               pad_swipe(cPADOPo->op_padix, TRUE);
+               cPADOPo->op_padix = 0;
+           }
+#else
            SvREFCNT_dec(cSVOPo->op_sv);
            cSVOPo->op_sv = NULL;
+#endif
        }
        else {
-           Safefree(cPVOPo->op_pv);
+           PerlMemShared_free(cPVOPo->op_pv);
            cPVOPo->op_pv = NULL;
        }
        break;
@@ -1551,10 +1558,6 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
        }
        break;
 
-    case OP_THREADSV:
-       o->op_flags |= OPf_MOD;         /* XXX ??? */
-       break;
-
     case OP_RV2AV:
     case OP_RV2HV:
        if (set_op_ref)
@@ -2060,7 +2063,8 @@ Perl_newPROG(pTHX_ OP *o)
 
        /* Register with debugger */
        if (PERLDB_INTER) {
-           CV * const cv = get_cv("DB::postponed", FALSE);
+           CV * const cv
+               = Perl_get_cvn_flags(aTHX_ STR_WITH_LEN("DB::postponed"), 0);
            if (cv) {
                dSP;
                PUSHMARK(SP);
@@ -2833,6 +2837,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     const I32 complement = o->op_private & OPpTRANS_COMPLEMENT;
     const I32 squash     = o->op_private & OPpTRANS_SQUASH;
     I32 del              = o->op_private & OPpTRANS_DELETE;
+    SV* swash;
     PL_hints |= HINT_BLOCK_SCOPE;
 
     if (SvUTF8(tstr))
@@ -3026,14 +3031,23 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        else
            bits = 8;
 
-       Safefree(cPVOPo->op_pv);
+       PerlMemShared_free(cPVOPo->op_pv);
        cPVOPo->op_pv = NULL;
-       cSVOPo->op_sv = (SV*)swash_init("utf8", "", listsv, bits, none);
+
+       swash = (SV*)swash_init("utf8", "", listsv, bits, none);
+#ifdef USE_ITHREADS
+       cPADOPo->op_padix = pad_alloc(OP_TRANS, SVs_PADTMP);
+       SvREFCNT_dec(PAD_SVl(cPADOPo->op_padix));
+       PAD_SETSV(cPADOPo->op_padix, swash);
+       SvPADTMP_on(swash);
+#else
+       cSVOPo->op_sv = swash;
+#endif
        SvREFCNT_dec(listsv);
        SvREFCNT_dec(transv);
 
        if (!del && havefinal && rlen)
-           (void)hv_store((HV*)SvRV((cSVOPo->op_sv)), "FINAL", 5,
+           (void)hv_store((HV*)SvRV(swash), "FINAL", 5,
                           newSVuv((UV)final), 0);
 
        if (grows)
@@ -3082,8 +3096,13 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            }
            else if (j >= (I32)rlen)
                j = rlen - 1;
-           else
-               cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
+           else {
+               tbl = 
+                   (short *)
+                   PerlMemShared_realloc(tbl,
+                                         (0x101+rlen-j) * sizeof(short));
+               cPVOPo->op_pv = (char*)tbl;
+           }
            tbl[0x100] = (short)(rlen - j);
            for (i=0; i < (I32)rlen - j; i++)
                tbl[0x101+i] = r[j+i];
@@ -3235,7 +3254,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
        STRLEN plen;
        SV * const pat = ((SVOP*)expr)->op_sv;
        const char *p = SvPV_const(pat, plen);
-       if ((o->op_flags & OPf_SPECIAL) && (*p == ' ' && p[1] == '\0')) {
+       if ((o->op_flags & OPf_SPECIAL) && (plen == 1 && *p == ' ')) {
            U32 was_readonly = SvREADONLY(pat);
 
            if (was_readonly) {
@@ -3259,8 +3278,10 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
            pm->op_pmdynflags |= PMdf_UTF8;
        /* FIXME - can we make this function take const char * args?  */
        PM_SETRE(pm, CALLREGCOMP((char*)p, (char*)p + plen, pm));
-       if (strEQ("\\s+", PM_GETRE(pm)->precomp))
+       if (PM_GETRE(pm)->extflags & RXf_WHITE)
            pm->op_pmflags |= PMf_WHITE;
+       else
+           pm->op_pmflags &= ~PMf_WHITE;
 #ifdef PERL_MAD
        op_getmad(expr,(OP*)pm,'e');
 #else
@@ -3461,8 +3482,7 @@ void
 Perl_package(pTHX_ OP *o)
 {
     dVAR;
-    const char *name;
-    STRLEN len;
+    SV *const sv = cSVOPo->op_sv;
 #ifdef PERL_MAD
     OP *pegop;
 #endif
@@ -3470,9 +3490,8 @@ Perl_package(pTHX_ OP *o)
     save_hptr(&PL_curstash);
     save_item(PL_curstname);
 
-    name = SvPV_const(cSVOPo->op_sv, len);
-    PL_curstash = gv_stashpvn(name, len, TRUE);
-    sv_setpvn(PL_curstname, name, len);
+    PL_curstash = gv_stashsv(sv, GV_ADD);
+    sv_setsv(PL_curstname, sv);
 
     PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
@@ -4514,17 +4533,6 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
            }
            sv = NULL;
        }
-       else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
-           padoff = sv->op_targ;
-           if (PL_madskills)
-               madsv = sv;
-           else {
-               sv->op_targ = 0;
-               iterflags |= OPf_SPECIAL;
-               op_free(sv);
-           }
-           sv = NULL;
-       }
        else
            Perl_croak(aTHX_ "Can't use %s for loop variable", PL_op_desc[sv->op_type]);
        if (padoff) {
@@ -4622,7 +4630,7 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
        if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
            o = newOP(type, OPf_SPECIAL);
        else {
-           o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
+           o = newPVOP(type, 0, savesharedpv(label->op_type == OP_CONST
                                        ? SvPVx_nolen_const(((SVOP*)label)->op_sv)
                                        : ""));
        }
@@ -5872,10 +5880,6 @@ Perl_newSVREF(pTHX_ OP *o)
        o->op_ppaddr = PL_ppaddr[OP_PADSV];
        return o;
     }
-    else if (o->op_type == OP_THREADSV && !(o->op_flags & OPpDONE_SVREF)) {
-       o->op_flags |= OPpDONE_SVREF;
-       return o;
-    }
     return newUNOP(OP_RV2SV, 0, scalar(o));
 }
 
@@ -7529,8 +7533,7 @@ Perl_ck_subr(pTHX_ OP *o)
                    if (o3->op_type == OP_RV2SV ||
                        o3->op_type == OP_PADSV ||
                        o3->op_type == OP_HELEM ||
-                       o3->op_type == OP_AELEM ||
-                       o3->op_type == OP_THREADSV)
+                       o3->op_type == OP_AELEM)
                         goto wrapref;
                    if (!contextclass)
                        bad_type(arg, "scalar", gv_ename(namegv), o3);