Allow for long long in h2xs
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 73061e3..62309a1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -378,6 +378,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
            cv = cx->blk_sub.cv;
            if (PL_debstash && CvSTASH(cv) == PL_debstash) {    /* ignore DB'* scope */
                saweval = i;    /* so we know where we were called from */
+               seq = cxstack[i].blk_oldcop->cop_seq;
                continue;
            }
            return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
@@ -841,16 +842,16 @@ clear_pmop:
                    lastpmop = pmop;
                    pmop = pmop->op_pmnext;
                }
+           }
 #ifdef USE_ITHREADS
-               Safefree(PmopSTASHPV(cPMOPo));
+           Safefree(PmopSTASHPV(cPMOPo));
 #else
-               /* NOTE: PMOP.op_pmstash is not refcounted */
+           /* NOTE: PMOP.op_pmstash is not refcounted */
 #endif
-           }
        }
        cPMOPo->op_pmreplroot = Nullop;
-       ReREFCNT_dec(cPMOPo->op_pmregexp);
-       cPMOPo->op_pmregexp = (REGEXP*)NULL;
+       ReREFCNT_dec(PM_GETRE(cPMOPo));
+       PM_SETRE(cPMOPo, (REGEXP*)NULL);
        break;
     }
 
@@ -2034,9 +2035,15 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
        right->op_type == OP_SUBST ||
        right->op_type == OP_TRANS)) {
        right->op_flags |= OPf_STACKED;
-       if (right->op_type != OP_MATCH &&
-            ! (right->op_type == OP_TRANS &&
-               right->op_private & OPpTRANS_IDENTICAL))
+       if ((right->op_type != OP_MATCH &&
+            ! (right->op_type == OP_TRANS &&
+               right->op_private & OPpTRANS_IDENTICAL)) ||
+           /* if SV has magic, then match on original SV, not on its copy.
+              see note in pp_helem() */
+           (right->op_type == OP_MATCH &&      
+            (left->op_type == OP_AELEM ||
+             left->op_type == OP_HELEM ||
+             left->op_type == OP_AELEMFAST)))
            left = mod(left, right->op_type);
        if (right->op_type == OP_TRANS)
            o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
@@ -2941,7 +2948,16 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
        pmop->op_pmpermflags |= PMf_LOCALE;
     pmop->op_pmflags = pmop->op_pmpermflags;
 
-    /* link into pm list */
+ #ifdef USE_ITHREADS
+        {
+                SV* repointer = newSViv(0);
+                av_push(PL_regex_padav,SvREFCNT_inc(repointer));
+                pmop->op_pmoffset = av_len(PL_regex_padav);
+                PL_regex_pad = AvARRAY(PL_regex_padav);
+        }
+ #endif
+        
+        /* link into pm list */
     if (type != OP_TRANS && PL_curstash) {
        pmop->op_pmnext = HvPMROOT(PL_curstash);
        HvPMROOT(PL_curstash) = pmop;
@@ -2975,8 +2991,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
        }
        if ((PL_hints & HINT_UTF8) || DO_UTF8(pat))
            pm->op_pmdynflags |= PMdf_UTF8;
-       pm->op_pmregexp = CALLREGCOMP(aTHX_ p, p + plen, pm);
-       if (strEQ("\\s+", pm->op_pmregexp->precomp))
+       PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm));
+       if (strEQ("\\s+", PM_GETRE(pm)->precomp))
            pm->op_pmflags |= PMf_WHITE;
        op_free(expr);
     }
@@ -3072,14 +3088,14 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
        }
        if (curop == repl
            && !(repl_has_vars
-                && (!pm->op_pmregexp
-                    || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
+                && (!PM_GETRE(pm)
+                    || PM_GETRE(pm)->reganch & ROPT_EVAL_SEEN))) {
            pm->op_pmflags |= PMf_CONST;        /* const for long enough */
            pm->op_pmpermflags |= PMf_CONST;    /* const for long enough */
            prepend_elem(o->op_type, scalar(repl), o);
        }
        else {
-           if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
+           if (curop == repl && !PM_GETRE(pm)) { /* Has variables. */
                pm->op_pmflags |= PMf_MAYBE_CONST;
                pm->op_pmpermflags |= PMf_MAYBE_CONST;
            }
@@ -3186,6 +3202,7 @@ Perl_package(pTHX_ OP *o)
        op_free(o);
     }
     else {
+       deprecate("\"package\" with no arguments");
        sv_setpv(PL_curstname,"<none>");
        PL_curstash = Nullhv;
     }
@@ -3930,7 +3947,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
     OP *next = 0;
     OP *listop;
     OP *o;
-    OP *condop;
     U8 loopflags = 0;
 
     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
@@ -3992,7 +4008,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
            return Nullop;              /* listop already freed by new_logop */
        }
        if (listop)
-           ((LISTOP*)listop)->op_last->op_next = condop =
+           ((LISTOP*)listop)->op_last->op_next =
                (o == listop ? redo : LINKLIST(o));
     }
     else
@@ -4152,6 +4168,14 @@ Perl_cv_undef(pTHX_ CV *cv)
     }
 #endif /* USE_THREADS */
 
+#ifdef USE_ITHREADS
+    if (CvFILE(cv) && !CvXSUB(cv)) {
+       /* for XSUBs CvFILE point directly to static memory; __FILE__ */
+       Safefree(CvFILE(cv));
+    }
+    CvFILE(cv) = 0;
+#endif
+
     if (!CvXSUB(cv) && CvROOT(cv)) {
 #ifdef USE_THREADS
        if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
@@ -4297,7 +4321,12 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv)                = 0;
 #endif /* USE_THREADS */
+#ifdef USE_ITHREADS
+    CvFILE(cv)         = CvXSUB(proto) ? CvFILE(proto)
+                                       : savepv(CvFILE(proto));
+#else
     CvFILE(cv)         = CvFILE(proto);
+#endif
     CvGV(cv)           = CvGV(proto);
     CvSTASH(cv)                = CvSTASH(proto);
     CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));
@@ -4586,9 +4615,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     cv = (!name || GvCVGEN(gv)) ? Nullcv : GvCV(gv);
 
-#ifdef GV_SHARED_CHECK
-    if (cv && GvSHARED(gv) && SvREADONLY(cv)) {
-        Perl_croak(aTHX_ "Can't define subroutine %s (GV is shared)", name);
+#ifdef GV_UNIQUE_CHECK
+    if (cv && GvUNIQUE(gv) && SvREADONLY(cv)) {
+        Perl_croak(aTHX_ "Can't define subroutine %s (GV is unique)", name);
     }
 #endif
 
@@ -4600,9 +4629,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (cv) {
         bool exists = CvROOT(cv) || CvXSUB(cv);
 
-#ifdef GV_SHARED_CHECK
-        if (exists && GvSHARED(gv)) {
-            Perl_croak(aTHX_ "Can't redefine shared subroutine %s", name);
+#ifdef GV_UNIQUE_CHECK
+        if (exists && GvUNIQUE(gv)) {
+            Perl_croak(aTHX_ "Can't redefine unique subroutine %s", name);
         }
 #endif
 
@@ -4721,6 +4750,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
        /* ... before we throw it away */
        SvREFCNT_dec(PL_compcv);
+       if (PERLDB_INTER)/* Advice debugger on the new sub. */
+         ++PL_sub_generation;
     }
     else {
        cv = PL_compcv;
@@ -4731,7 +4762,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
     CvGV(cv) = gv;
-    CvFILE(cv) = CopFILE(PL_curcop);
+    CvFILE_set_from_cop(cv, PL_curcop);
     CvSTASH(cv) = PL_curstash;
 #ifdef USE_THREADS
     CvOWNER(cv) = 0;
@@ -5090,9 +5121,9 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     else
        name = "STDOUT";
     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
-#ifdef GV_SHARED_CHECK
-    if (GvSHARED(gv)) {
-        Perl_croak(aTHX_ "Bad symbol for form (GV is shared)");
+#ifdef GV_UNIQUE_CHECK
+    if (GvUNIQUE(gv)) {
+        Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
     }
 #endif
     GvMULTI_on(gv);
@@ -5109,7 +5140,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     cv = PL_compcv;
     GvFORM(gv) = cv;
     CvGV(cv) = gv;
-    CvFILE(cv) = CopFILE(PL_curcop);
+    CvFILE_set_from_cop(cv, PL_curcop);
 
     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
        if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
@@ -6441,8 +6472,8 @@ Perl_ck_join(pTHX_ OP *o)
        OP *kid = cLISTOPo->op_first->op_sibling;
        if (kid && kid->op_type == OP_MATCH) {
            char *pmstr = "STRING";
-           if (kPMOP->op_pmregexp)
-               pmstr = kPMOP->op_pmregexp->precomp;
+           if (PM_GETRE(kPMOP))
+               pmstr = PM_GETRE(kPMOP)->precomp;
            Perl_warner(aTHX_ WARN_SYNTAX,
                        "/%s/ should probably be written as \"%s\"",
                        pmstr, pmstr);
@@ -6750,7 +6781,15 @@ Perl_peep(pTHX_ register OP *o)
            {
                PL_curcop = ((COP*)o);
            }
-           goto nothin;
+           /* XXX: We avoid setting op_seq here to prevent later calls
+              to peep() from mistakenly concluding that optimisation
+              has already occurred. This doesn't fix the real problem,
+              though (See 20010220.007). AMS 20010719 */
+           if (oldop && o->op_next) {
+               oldop->op_next = o->op_next;
+               continue;
+           }
+           break;
        case OP_SCALAR:
        case OP_LINESEQ:
        case OP_SCOPE:
@@ -6889,9 +6928,9 @@ Perl_peep(pTHX_ register OP *o)
            svp = cSVOPx_svp(((BINOP*)o)->op_last);
            if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) {
                key = SvPV(sv, keylen);
-               if (SvUTF8(sv))
-                 keylen = -keylen;
-               lexname = newSVpvn_share(key, keylen, 0);
+               lexname = newSVpvn_share(key,
+                                        SvUTF8(sv) ? -(I32)keylen : keylen,
+                                        0);
                SvREFCNT_dec(sv);
                *svp = lexname;
            }
@@ -6909,9 +6948,8 @@ Perl_peep(pTHX_ register OP *o)
            if (!fields || !GvHV(*fields))
                break;
            key = SvPV(*svp, keylen);
-           if (SvUTF8(*svp))
-               keylen = -keylen;
-           indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
+           indsvp = hv_fetch(GvHV(*fields), key,
+                             SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE);
            if (!indsvp) {
                Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" in variable %s of type %s",
                      key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
@@ -6976,9 +7014,8 @@ Perl_peep(pTHX_ register OP *o)
                 key_op = (SVOP*)key_op->op_sibling) {
                svp = cSVOPx_svp(key_op);
                key = SvPV(*svp, keylen);
-               if (SvUTF8(*svp))
-                   keylen = -keylen;
-               indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
+               indsvp = hv_fetch(GvHV(*fields), key,
+                                 SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE);
                if (!indsvp) {
                    Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" "
                               "in variable %s of type %s",