- shift() inside BEGIN|END|INIT now shifts @ARGV instead of @_
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 513a650..73c8584 100644 (file)
--- a/op.c
+++ b/op.c
@@ -40,6 +40,7 @@ static OP *too_many_arguments _((OP *o, char* name));
 static void null _((OP* o));
 static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
        CV* startcv, I32 cx_ix));
+static OP *newDEFSVOP _((void));
 
 static char*
 gv_ename(GV *gv)
@@ -163,7 +164,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
     I32 off;
     SV *sv;
     register I32 i;
-    register CONTEXT *cx;
+    register PERL_CONTEXT *cx;
     int saweval;
 
     for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
@@ -496,36 +497,47 @@ pad_reset(void)
 }
 
 #ifdef USE_THREADS
-/* find_thread_magical is not reentrant */
+/* find_threadsv is not reentrant */
 PADOFFSET
-find_thread_magical(char *name)
+find_threadsv(char *name)
 {
     dTHR;
     char *p;
     PADOFFSET key;
     SV **svp;
-    /* We currently only handle single character magicals */
-    p = strchr(per_thread_magicals, *name);
+    /* We currently only handle names of a single character */
+    p = strchr(threadsv_names, *name);
     if (!p)
        return NOT_IN_PAD;
-    key = p - per_thread_magicals;
-    svp = av_fetch(thr->magicals, key, FALSE);
+    key = p - threadsv_names;
+    svp = av_fetch(thr->threadsv, key, FALSE);
     if (!svp) {
        SV *sv = NEWSV(0, 0);
-       av_store(thr->magicals, key, sv);
+       av_store(thr->threadsv, key, sv);
        /*
         * Some magic variables used to be automagically initialised
         * in gv_fetchpv. Those which are now per-thread magicals get
         * initialised here instead.
         */
        switch (*name) {
+       case '_':
+           break;
        case ';':
            sv_setpv(sv, "\034");
+           sv_magic(sv, 0, 0, name, 1); 
+           break;
+       case '&':
+       case '`':
+       case '\'':
+           sawampersand = TRUE;
+           SvREADONLY_on(sv);
+           sv_magic(sv, 0, 0, name, 1); 
            break;
+       default:
+           sv_magic(sv, 0, 0, name, 1); 
        }
-       sv_magic(sv, 0, 0, name, 1); 
        DEBUG_L(PerlIO_printf(PerlIO_stderr(),
-                             "find_thread_magical: new SV %p for $%s%c\n",
+                             "find_threadsv: new SV %p for $%s%c\n",
                              sv, (*name < 32) ? "^" : "",
                              (*name < 32) ? toCTRL(*name) : *name));
     }
@@ -558,8 +570,8 @@ op_free(OP *o)
        o->op_targ = 0; /* Was holding hints. */
        break;
 #ifdef USE_THREADS
-    case OP_SPECIFIC:
-       o->op_targ = 0; /* Was holding index into thr->magicals AV. */
+    case OP_THREADSV:
+       o->op_targ = 0; /* Was holding index into thr->threadsv AV. */
        break;
 #endif /* USE_THREADS */
     default:
@@ -594,8 +606,7 @@ op_free(OP *o)
        /* FALL THROUGH */
     case OP_PUSHRE:
     case OP_MATCH:
-       pregfree(cPMOPo->op_pmregexp);
-       SvREFCNT_dec(cPMOPo->op_pmshort);
+       ReREFCNT_dec(cPMOPo->op_pmregexp);
        break;
     }
 
@@ -608,7 +619,7 @@ op_free(OP *o)
 static void
 null(OP *o)
 {
-    if (o->op_type != OP_NULL && o->op_targ > 0)
+    if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
        pad_free(o->op_targ);
     o->op_targ = o->op_type;
     o->op_type = OP_NULL;
@@ -1147,7 +1158,7 @@ mod(OP *o, I32 type)
     case OP_RV2SV:
        if (!type && cUNOPo->op_first->op_type != OP_GV)
            croak("Can't localize through a reference");
-       ref(cUNOPo->op_first, o->op_type); 
+       ref(cUNOPo->op_first, o->op_type);
        /* FALL THROUGH */
     case OP_GV:
     case OP_AV2ARYLEN:
@@ -1172,12 +1183,8 @@ mod(OP *o, I32 type)
        break;
 
 #ifdef USE_THREADS
-    case OP_SPECIFIC:
+    case OP_THREADSV:
        modcount++;     /* XXX ??? */
-#if 0
-       if (!type) 
-           croak("Can't localize thread-specific variable");
-#endif
        break;
 #endif /* USE_THREADS */
 
@@ -1314,7 +1321,7 @@ ref(OP *o, I32 type)
            o->op_flags |= OPf_SPECIAL;
        }
        break;
-      
+
     case OP_COND_EXPR:
        for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
            ref(kid, type);
@@ -1331,9 +1338,13 @@ ref(OP *o, I32 type)
        }
        break;
       
+    case OP_THREADSV:
+       o->op_flags |= OPf_MOD;         /* XXX ??? */
+       break;
+
     case OP_RV2AV:
     case OP_RV2HV:
-       o->op_flags |= OPf_REF; 
+       o->op_flags |= OPf_REF;
        /* FALL THROUGH */
     case OP_RV2GV:
        ref(cUNOPo->op_first, o->op_type);
@@ -1341,9 +1352,9 @@ ref(OP *o, I32 type)
 
     case OP_PADAV:
     case OP_PADHV:
-       o->op_flags |= OPf_REF; 
+       o->op_flags |= OPf_REF;
        break;
-      
+
     case OP_SCALAR:
     case OP_NULL:
        if (!(o->op_flags & OPf_KIDS))
@@ -1524,6 +1535,18 @@ block_end(I32 floor, OP *seq)
     return retval;
 }
 
+static OP *
+newDEFSVOP(void)
+{
+#ifdef USE_THREADS
+    OP *o = newOP(OP_THREADSV, 0);
+    o->op_targ = find_threadsv("_");
+    return o;
+#else
+    return newSVREF(newGVOP(OP_GV, 0, defgv));
+#endif /* USE_THREADS */
+}
+
 void
 newPROG(OP *o)
 {
@@ -1586,8 +1609,8 @@ jmaybe(OP *o)
     if (o->op_type == OP_LIST) {
        OP *o2;
 #ifdef USE_THREADS
-       o2 = newOP(OP_SPECIFIC, 0);
-       o2->op_targ = find_thread_magical(";");
+       o2 = newOP(OP_THREADSV, 0);
+       o2->op_targ = find_threadsv(";");
 #else
        o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
 #endif /* USE_THREADS */
@@ -1664,7 +1687,7 @@ fold_constants(register OP *o)
        }
        return newSVOP(OP_CONST, 0, sv);
     }
-    
+
   nope:
     if (!(opargs[type] & OA_OTHERINT))
        return o;
@@ -1904,7 +1927,7 @@ newUNOP(I32 type, I32 flags, OP *first)
     UNOP *unop;
 
     if (!first)
-       first = newOP(OP_STUB, 0); 
+       first = newOP(OP_STUB, 0);
     if (opargs[type] & OA_MARK)
        first = force_list(first);
 
@@ -1914,7 +1937,12 @@ newUNOP(I32 type, I32 flags, OP *first)
     unop->op_first = first;
     unop->op_flags = flags | OPf_KIDS;
     unop->op_private = 1 | (flags >> 8);
-
+#if 1
+    if(type == OP_STUDY && first->op_type == OP_MATCH) {
+       first->op_type = OP_PUSHRE;
+       first->op_ppaddr = ppaddr[OP_PUSHRE];
+    }
+#endif
     unop = (UNOP*) CHECKOP(type, unop);
     if (unop->op_next)
        return (OP*)unop;
@@ -2063,9 +2091,8 @@ pmruntime(OP *o, OP *expr, OP *repl)
            pm->op_pmflags |= PMf_SKIPWHITE;
        }
        pm->op_pmregexp = pregcomp(p, p + plen, pm);
-       if (strEQ("\\s+", pm->op_pmregexp->precomp)) 
+       if (strEQ("\\s+", pm->op_pmregexp->precomp))
            pm->op_pmflags |= PMf_WHITE;
-       hoistmust(pm);
        op_free(expr);
     }
     else {
@@ -2099,9 +2126,9 @@ pmruntime(OP *o, OP *expr, OP *repl)
        if (pm->op_pmflags & PMf_EVAL)
            curop = 0;
 #ifdef USE_THREADS
-       else if (repl->op_type == OP_SPECIFIC
+       else if (repl->op_type == OP_THREADSV
                 && strchr("&`'123456789+",
-                          per_thread_magicals[repl->op_targ]))
+                          threadsv_names[repl->op_targ]))
        {
            curop = 0;
        }
@@ -2113,7 +2140,7 @@ pmruntime(OP *o, OP *expr, OP *repl)
            for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
                if (opargs[curop->op_type] & OA_DANGEROUS) {
 #ifdef USE_THREADS
-                   if (curop->op_type == OP_SPECIFIC
+                   if (curop->op_type == OP_THREADSV
                        && strchr("&`'123456789+", curop->op_private)) {
                        break;
                    }
@@ -2287,7 +2314,7 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
                            newUNOP(OP_METHOD, 0, meth)));
        }
     }
-     
+
     /* Fake up an import/unimport */
     if (arg && arg->op_type == OP_STUB)
        imop = arg;             /* no import on explicit () */
@@ -2784,7 +2811,7 @@ newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block)
        if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
            || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
            expr = newUNOP(OP_DEFINED, 0,
-               newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
+               newASSIGNOP(0, newDEFSVOP(), 0, expr) );
        }
     }
 
@@ -2818,7 +2845,7 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b
     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
                 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
        expr = newUNOP(OP_DEFINED, 0,
-           newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
+           newASSIGNOP(0, newDEFSVOP(), 0, expr) );
     }
 
     if (!block)
@@ -2845,7 +2872,7 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b
            op_free((OP*)loop);
            return Nullop;              /* (listop already freed by newLOGOP) */
        }
-       ((LISTOP*)listop)->op_last->op_next = condop = 
+       ((LISTOP*)listop)->op_last->op_next = condop =
            (o == listop ? redo : LINKLIST(o));
        if (!next)
            next = condop;
@@ -2905,11 +2932,22 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
            op_free(sv);
            sv = Nullop;
        }
+       else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
+           padoff = sv->op_targ;
+           iterflags |= OPf_SPECIAL;
+           op_free(sv);
+           sv = Nullop;
+       }
        else
            croak("Can't use %s for loop variable", op_desc[sv->op_type]);
     }
     else {
+#ifdef USE_THREADS
+       padoff = find_threadsv("_");
+       iterflags |= OPf_SPECIAL;
+#else
        sv = newGVOP(OP_GV, 0, defgv);
+#endif
     }
     if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
        expr = scalar(ref(expr, OP_ITER));
@@ -3218,7 +3256,7 @@ cv_const_sv(CV *cv)
 {
     OP *o;
     SV *sv;
-    
+
     if (!cv || !SvPOK(cv) || SvCUR(cv))
        return Nullsv;
 
@@ -3334,8 +3372,8 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
                    croak(not_safe);
                else {
                    /* force display of errors found but not reported */
-                   sv_catpv(GvSV(errgv), not_safe);
-                   croak("%s", SvPVx(GvSV(errgv), na));
+                   sv_catpv(ERRSV, not_safe);
+                   croak("%s", SvPVx(ERRSV, na));
                }
            }
        }
@@ -3400,9 +3438,9 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
            CV *cv;
            HV *hv;
 
-           sv_setpvf(sv, "%_:%ld-%ld",
-                   GvSV(curcop->cop_filegv),
-                   (long)subline, (long)curcop->cop_line);
+           sv_setpvf(sv, "%_:%ld-%ld", GvSV(curcop->cop_filegv),
+                   (long)(subline < 0 ? -subline : subline),
+                   (long)curcop->cop_line);
            gv_efullname3(tmpstr, gv, Nullch);
            hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
            if (!db_postponed) {
@@ -3463,7 +3501,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 }
 
 CV *
-newXS(char *name, void (*subaddr) _((CV *)), char *filename)
+newXS(char *name, void (*subaddr) (CV *), char *filename)
 {
     dTHR;
     GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
@@ -3702,6 +3740,8 @@ newSVREF(OP *o)
        o->op_ppaddr = ppaddr[OP_PADSV];
        return o;
     }
+    else if (o->op_type == OP_THREADSV)
+       return o;
     return newUNOP(OP_RV2SV, 0, scalar(o));
 }
 
@@ -3757,7 +3797,7 @@ ck_spair(OP *o)
             !(opargs[newop->op_type] & OA_RETSCALAR) ||
             newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
             newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
-           
+       
            return o;
        }
        op_free(kUNOP->op_first);
@@ -3835,7 +3875,7 @@ ck_eval(OP *o)
     }
     else {
        op_free(o);
-       o = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+       o = newUNOP(OP_ENTEREVAL, 0, newDEFSVOP());
     }
     o->op_targ = (PADOFFSET)hints;
     return o;
@@ -3963,7 +4003,7 @@ ck_ftst(OP *o)
            return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
                                SVt_PVIO));
        else
-           return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+           return newUNOP(type, 0, newDEFSVOP());
     }
     return o;
 }
@@ -3978,7 +4018,7 @@ ck_fun(OP *o)
     I32 numargs = 0;
     int type = o->op_type;
     register I32 oa = opargs[type] >> OASHIFT;
-    
+
     if (o->op_flags & OPf_STACKED) {
        if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
            oa &= ~OA_OPTIONAL;
@@ -3996,7 +4036,7 @@ ck_fun(OP *o)
            kid = kid->op_sibling;
        }
        if (!kid && opargs[type] & OA_DEFGV)
-           *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
+           *tokid = kid = newDEFSVOP();
 
        while (oa && kid) {
            numargs++;
@@ -4094,7 +4134,7 @@ ck_fun(OP *o)
     }
     else if (opargs[type] & OA_DEFGV) {
        op_free(o);
-       return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+       return newUNOP(type, 0, newDEFSVOP());
     }
 
     if (oa) {
@@ -4112,7 +4152,7 @@ ck_glob(OP *o)
     GV *gv;
 
     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
-       append_elem(OP_GLOB, o, newSVREF(newGVOP(OP_GV, 0, defgv)));
+       append_elem(OP_GLOB, o, newDEFSVOP());
 
     if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
@@ -4127,7 +4167,7 @@ ck_glob(OP *o)
        cLISTOPo->op_first->op_type = OP_PUSHMARK;
        cLISTOPo->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
        o = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                   append_elem(OP_LIST, o, 
+                   append_elem(OP_LIST, o,
                                scalar(newUNOP(OP_RV2CV, 0,
                                               newGVOP(OP_GV, 0, gv)))));
        o = newUNOP(OP_NULL, 0, ck_subr(o));
@@ -4150,7 +4190,7 @@ ck_grep(OP *o)
 
     o->op_ppaddr = ppaddr[OP_GREPSTART];
     Newz(1101, gwop, 1, LOGOP);
-    
+
     if (o->op_flags & OPf_STACKED) {
        OP* k;
        o = ck_sort(o);
@@ -4169,7 +4209,7 @@ ck_grep(OP *o)
     o = ck_fun(o);
     if (error_count)
        return o;
-    kid = cLISTOPo->op_first->op_sibling; 
+    kid = cLISTOPo->op_first->op_sibling;
     if (kid->op_type != OP_NULL)
        croak("panic: ck_grep");
     kid = kUNOP->op_first;
@@ -4228,7 +4268,7 @@ OP *
 ck_listiob(OP *o)
 {
     register OP *kid;
-    
+
     kid = cLISTOPo->op_first;
     if (!kid) {
        o = force_list(o);
@@ -4249,7 +4289,7 @@ ck_listiob(OP *o)
     }
        
     if (!kid)
-       append_elem(o->op_type, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+       append_elem(o->op_type, o, newDEFSVOP());
 
     o = listkids(o);
 
@@ -4372,7 +4412,7 @@ ck_shift(OP *o)
        
        op_free(o);
 #ifdef USE_THREADS
-       if (subline) {
+       if (subline > 0) {
            argop = newOP(OP_PADAV, OPf_REF);
            argop->op_targ = 0;         /* curpad[0] is @_ */
        }
@@ -4383,7 +4423,7 @@ ck_shift(OP *o)
        }
 #else
        argop = newUNOP(OP_RV2AV, 0,
-           scalar(newGVOP(OP_GV, 0, subline ?
+           scalar(newGVOP(OP_GV, 0, subline > 0 ?
                           defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
 #endif /* USE_THREADS */
        return newUNOP(type, 0, scalar(argop));
@@ -4444,8 +4484,7 @@ OP *
 ck_split(OP *o)
 {
     register OP *kid;
-    PMOP* pm;
-    
+
     if (o->op_flags & OPf_STACKED)
        return no_fh_allowed(o);
 
@@ -4469,18 +4508,13 @@ ck_split(OP *o)
        cLISTOPo->op_first = kid;
        kid->op_sibling = sibl;
     }
-    pm = (PMOP*)kid;
-    if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
-       SvREFCNT_dec(pm->op_pmshort);   /* can't use substring to optimize */
-       pm->op_pmshort = 0;
-    }
 
     kid->op_type = OP_PUSHRE;
     kid->op_ppaddr = ppaddr[OP_PUSHRE];
     scalar(kid);
 
     if (!kid->op_sibling)
-       append_elem(OP_SPLIT, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+       append_elem(OP_SPLIT, o, newDEFSVOP());
 
     kid = kid->op_sibling;
     scalar(kid);
@@ -4677,7 +4711,7 @@ peep(register OP *o)
        case OP_LC:
        case OP_LCFIRST:
        case OP_QUOTEMETA:
-           if (o->op_next->op_type == OP_STRINGIFY)
+           if (o->op_next && o->op_next->op_type == OP_STRINGIFY)
                null(o->op_next);
            o->op_seq = op_seqmax++;
            break;
@@ -4747,7 +4781,7 @@ peep(register OP *o)
                o->op_next = o->op_next->op_next;
            }
            break;
-           
+       
        case OP_PADHV:
            if (o->op_next->op_type == OP_RV2HV
                && (o->op_next->op_flags && OPf_REF))
@@ -4798,7 +4832,7 @@ peep(register OP *o)
                }
            }
            break;
-           
+       
        case OP_HELEM: {
            UNOP *rop;
            SV *lexname;
@@ -4807,7 +4841,7 @@ peep(register OP *o)
            I32 ind;
            char *key;
            STRLEN keylen;
-           
+       
            if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)
                || ((BINOP*)o)->op_last->op_type != OP_CONST)
                break;