This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Change SAVECOPWARNINGS(c) to SAVECOMPILEWARNINGS() - it's only used to
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 31b8e8d..593485d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -506,7 +506,7 @@ S_cop_free(pTHX_ COP* cop)
     CopFILE_free(cop);
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
     CopFILE_free(cop);
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
-       SvREFCNT_dec(cop->cop_warnings);
+       PerlMemShared_free(cop->cop_warnings);
     if (! specialCopIO(cop->cop_io)) {
 #ifdef USE_ITHREADS
        /*EMPTY*/
     if (! specialCopIO(cop->cop_io)) {
 #ifdef USE_ITHREADS
        /*EMPTY*/
@@ -1103,12 +1103,13 @@ Perl_mod(pTHX_ OP *o, I32 type)
            goto nomod;
        localize = 0;
        if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
            goto nomod;
        localize = 0;
        if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
-           PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv);
+           CopARYBASE_set(&PL_compiling,
+                          (I32)SvIV(cSVOPx(PL_eval_start)->op_sv));
            PL_eval_start = 0;
        }
        else if (!type) {
            PL_eval_start = 0;
        }
        else if (!type) {
-           SAVEI32(PL_compiling.cop_arybase);
-           PL_compiling.cop_arybase = 0;
+           SAVECOPARYBASE(&PL_compiling);
+           CopARYBASE_set(&PL_compiling, 0);
        }
        else if (type == OP_REFGEN)
            goto nomod;
        }
        else if (type == OP_REFGEN)
            goto nomod;
@@ -1973,7 +1974,7 @@ Perl_scope(pTHX_ OP *o)
     }
     return o;
 }
     }
     return o;
 }
-
+       
 int
 Perl_block_start(pTHX_ int full)
 {
 int
 Perl_block_start(pTHX_ int full)
 {
@@ -1982,11 +1983,8 @@ Perl_block_start(pTHX_ int full)
     pad_block_start(full);
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
     pad_block_start(full);
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    SAVESPTR(PL_compiling.cop_warnings);
-    if (! specialWARN(PL_compiling.cop_warnings)) {
-        PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
-        SAVEFREESV(PL_compiling.cop_warnings) ;
-    }
+    SAVECOMPILEWARNINGS();
+    PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
     SAVESPTR(PL_compiling.cop_io);
     if (! specialCopIO(PL_compiling.cop_io)) {
         PL_compiling.cop_io = newSVsv(PL_compiling.cop_io) ;
     SAVESPTR(PL_compiling.cop_io);
     if (! specialCopIO(PL_compiling.cop_io)) {
         PL_compiling.cop_io = newSVsv(PL_compiling.cop_io) ;
@@ -2002,7 +2000,7 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
     const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
     OP* const retval = scalarseq(seq);
     LEAVE_SCOPE(floor);
     const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
     OP* const retval = scalarseq(seq);
     LEAVE_SCOPE(floor);
-    PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+    CopHINTS_set(&PL_compiling, PL_hints);
     if (needblockscope)
        PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
     pad_leavemy();
     if (needblockscope)
        PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
     pad_leavemy();
@@ -2141,7 +2139,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     register OP *curop;
     OP *newop;
     I32 type = o->op_type;
     register OP *curop;
     OP *newop;
     I32 type = o->op_type;
-    SV *sv;
+    SV *sv = NULL;
     int ret = 0;
     I32 oldscope;
     OP *old_next;
     int ret = 0;
     I32 oldscope;
     OP *old_next;
@@ -2242,6 +2240,7 @@ Perl_fold_constants(pTHX_ register OP *o)
 #ifndef PERL_MAD
     op_free(o);
 #endif
 #ifndef PERL_MAD
     op_free(o);
 #endif
+    assert(sv);
     if (type == OP_RV2GV)
        newop = newGVOP(OP_GV, 0, (GV*)sv);
     else
     if (type == OP_RV2GV)
        newop = newGVOP(OP_GV, 0, (GV*)sv);
     else
@@ -2841,6 +2840,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        const I32 to_utf    = o->op_private & OPpTRANS_TO_UTF;
        U8* tsave = NULL;
        U8* rsave = NULL;
        const I32 to_utf    = o->op_private & OPpTRANS_TO_UTF;
        U8* tsave = NULL;
        U8* rsave = NULL;
+       const U32 flags = UTF8_ALLOW_DEFAULT;
 
        if (!from_utf) {
            STRLEN len = tlen;
 
        if (!from_utf) {
            STRLEN len = tlen;
@@ -2867,11 +2867,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            i = 0;
            transv = newSVpvs("");
            while (t < tend) {
            i = 0;
            transv = newSVpvs("");
            while (t < tend) {
-               cp[2*i] = utf8n_to_uvuni(t, tend-t, &ulen, 0);
+               cp[2*i] = utf8n_to_uvuni(t, tend-t, &ulen, flags);
                t += ulen;
                if (t < tend && NATIVE_TO_UTF(*t) == 0xff) {
                    t++;
                t += ulen;
                if (t < tend && NATIVE_TO_UTF(*t) == 0xff) {
                    t++;
-                   cp[2*i+1] = utf8n_to_uvuni(t, tend-t, &ulen, 0);
+                   cp[2*i+1] = utf8n_to_uvuni(t, tend-t, &ulen, flags);
                    t += ulen;
                }
                else {
                    t += ulen;
                }
                else {
@@ -2925,11 +2925,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        while (t < tend || tfirst <= tlast) {
            /* see if we need more "t" chars */
            if (tfirst > tlast) {
        while (t < tend || tfirst <= tlast) {
            /* see if we need more "t" chars */
            if (tfirst > tlast) {
-               tfirst = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
+               tfirst = (I32)utf8n_to_uvuni(t, tend - t, &ulen, flags);
                t += ulen;
                if (t < tend && NATIVE_TO_UTF(*t) == 0xff) {    /* illegal utf8 val indicates range */
                    t++;
                t += ulen;
                if (t < tend && NATIVE_TO_UTF(*t) == 0xff) {    /* illegal utf8 val indicates range */
                    t++;
-                   tlast = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
+                   tlast = (I32)utf8n_to_uvuni(t, tend - t, &ulen, flags);
                    t += ulen;
                }
                else
                    t += ulen;
                }
                else
@@ -2939,11 +2939,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            /* now see if we need more "r" chars */
            if (rfirst > rlast) {
                if (r < rend) {
            /* now see if we need more "r" chars */
            if (rfirst > rlast) {
                if (r < rend) {
-                   rfirst = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
+                   rfirst = (I32)utf8n_to_uvuni(r, rend - r, &ulen, flags);
                    r += ulen;
                    if (r < rend && NATIVE_TO_UTF(*r) == 0xff) {        /* illegal utf8 val indicates range */
                        r++;
                    r += ulen;
                    if (r < rend && NATIVE_TO_UTF(*r) == 0xff) {        /* illegal utf8 val indicates range */
                        r++;
-                       rlast = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
+                       rlast = (I32)utf8n_to_uvuni(r, rend - r, &ulen, flags);
                        r += ulen;
                    }
                    else
                        r += ulen;
                    }
                    else
@@ -3906,7 +3906,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
        else {
            /* FIXME for MAD */
            op_free(o);
        else {
            /* FIXME for MAD */
            op_free(o);
-           o = newSVOP(OP_CONST, 0, newSViv(PL_compiling.cop_arybase));
+           o = newSVOP(OP_CONST, 0, newSViv(CopARYBASE_get(&PL_compiling)));
            o->op_private |= OPpCONST_ARYBASE;
        }
     }
            o->op_private |= OPpCONST_ARYBASE;
        }
     }
@@ -3930,11 +3930,11 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
     }
     cop->op_flags = (U8)flags;
        cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
     }
     cop->op_flags = (U8)flags;
-    cop->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+    CopHINTS_set(cop, PL_hints);
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
-    PL_compiling.op_private = cop->op_private;
+    CopHINTS_set(&PL_compiling, CopHINTS_get(cop));
     cop->op_next = (OP*)cop;
 
     if (label) {
     cop->op_next = (OP*)cop;
 
     if (label) {
@@ -3942,18 +3942,17 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        PL_hints |= HINT_BLOCK_SCOPE;
     }
     cop->cop_seq = seq;
        PL_hints |= HINT_BLOCK_SCOPE;
     }
     cop->cop_seq = seq;
-    cop->cop_arybase = PL_curcop->cop_arybase;
-    if (specialWARN(PL_curcop->cop_warnings))
-        cop->cop_warnings = PL_curcop->cop_warnings ;
-    else
-        cop->cop_warnings = newSVsv(PL_curcop->cop_warnings) ;
+    CopARYBASE_set(cop, CopARYBASE_get(PL_curcop));
+    cop->cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
     if (specialCopIO(PL_curcop->cop_io))
         cop->cop_io = PL_curcop->cop_io;
     else
         cop->cop_io = newSVsv(PL_curcop->cop_io) ;
     cop->cop_hints = PL_curcop->cop_hints;
     if (cop->cop_hints) {
     if (specialCopIO(PL_curcop->cop_io))
         cop->cop_io = PL_curcop->cop_io;
     else
         cop->cop_io = newSVsv(PL_curcop->cop_io) ;
     cop->cop_hints = PL_curcop->cop_hints;
     if (cop->cop_hints) {
+       HINTS_REFCNT_LOCK;
        cop->cop_hints->refcounted_he_refcnt++;
        cop->cop_hints->refcounted_he_refcnt++;
+       HINTS_REFCNT_UNLOCK;
     }
 
     if (PL_copline == NOLINE)
     }
 
     if (PL_copline == NOLINE)
@@ -4534,7 +4533,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
        loop = tmp;
     }
 #else
        loop = tmp;
     }
 #else
-    Renew(loop, 1, LOOP);
+    loop = PerlMemShared_realloc(loop, sizeof(LOOP));
 #endif
     loop->op_targ = padoff;
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0);
 #endif
     loop->op_targ = padoff;
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0);
@@ -5119,7 +5118,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
     if (const_sv) {
        }
     }
     if (const_sv) {
-       SvREFCNT_inc_void_NN(const_sv);
+       SvREFCNT_inc_simple_void_NN(const_sv);
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
            sv_setpvn((SV*)cv, "", 0);  /* prototype is "" */
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
            sv_setpvn((SV*)cv, "", 0);  /* prototype is "" */
@@ -5332,7 +5331,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            call_list(oldscope, PL_beginav);
 
            PL_curcop = &PL_compiling;
            call_list(oldscope, PL_beginav);
 
            PL_curcop = &PL_compiling;
-           PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+           CopHINTS_set(&PL_compiling, PL_hints);
            LEAVE;
        }
        else if (strEQ(s, "END") && !PL_error_count) {
            LEAVE;
        }
        else if (strEQ(s, "END") && !PL_error_count) {
@@ -7648,7 +7647,7 @@ Perl_peep(pTHX_ register OP *o)
                    pop->op_next->op_type == OP_AELEM &&
                    !(pop->op_next->op_private &
                      (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) &&
                    pop->op_next->op_type == OP_AELEM &&
                    !(pop->op_next->op_private &
                      (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) &&
-                   (i = SvIV(((SVOP*)pop)->op_sv) - PL_curcop->cop_arybase)
+                   (i = SvIV(((SVOP*)pop)->op_sv) - CopARYBASE_get(PL_curcop))
                                <= 255 &&
                    i >= 0)
                {
                                <= 255 &&
                    i >= 0)
                {