X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=6a23961deb8bf98b70e510ea92f70d66deb0eb71;hb=1cc8b4c566f7901a54e4b576f09608beb4c81f86;hp=272f506943ad0815ab50a10af1a4b6d0cf377e52;hpb=986b19de108d7d28065c88eb6f0409b17efc8482;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index 272f506..6a23961 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -86,29 +86,36 @@ PP(pp_regcomp) SV *tmpstr; STRLEN len; MAGIC *mg = Null(MAGIC*); - + tmpstr = POPs; + + /* prevent recompiling under /o and ithreads. */ +#if defined(USE_ITHREADS) || defined(USE_5005THREADS) + if (pm->op_pmflags & PMf_KEEP && PM_GETRE(pm)) + RETURN; +#endif + if (SvROK(tmpstr)) { SV *sv = SvRV(tmpstr); if(SvMAGICAL(sv)) - mg = mg_find(sv, 'r'); + mg = mg_find(sv, PERL_MAGIC_qr); } if (mg) { regexp *re = (regexp *)mg->mg_obj; - ReREFCNT_dec(pm->op_pmregexp); - pm->op_pmregexp = ReREFCNT_inc(re); + ReREFCNT_dec(PM_GETRE(pm)); + PM_SETRE(pm, ReREFCNT_inc(re)); } else { t = SvPV(tmpstr, len); /* Check against the last compiled regexp. */ - if (!pm->op_pmregexp || !pm->op_pmregexp->precomp || - pm->op_pmregexp->prelen != len || - memNE(pm->op_pmregexp->precomp, t, len)) + if (!PM_GETRE(pm) || !PM_GETRE(pm)->precomp || + PM_GETRE(pm)->prelen != len || + memNE(PM_GETRE(pm)->precomp, t, len)) { - if (pm->op_pmregexp) { - ReREFCNT_dec(pm->op_pmregexp); - pm->op_pmregexp = Null(REGEXP*); /* crucial if regcomp aborts */ + if (PM_GETRE(pm)) { + ReREFCNT_dec(PM_GETRE(pm)); + PM_SETRE(pm, Null(REGEXP*)); /* crucial if regcomp aborts */ } if (PL_op->op_flags & OPf_SPECIAL) PL_reginterp_cnt = I32_MAX; /* Mark as safe. */ @@ -121,7 +128,7 @@ PP(pp_regcomp) if (pm->op_pmdynflags & PMdf_UTF8) t = (char*)bytes_to_utf8((U8*)t, &len); } - pm->op_pmregexp = CALLREGCOMP(aTHX_ t, t + len, pm); + PM_SETRE(pm, CALLREGCOMP(aTHX_ t, t + len, pm)); if (!DO_UTF8(tmpstr) && (pm->op_pmdynflags & PMdf_UTF8)) Safefree(t); PL_reginterp_cnt = 0; /* XXXX Be extra paranoid - needed @@ -138,15 +145,17 @@ PP(pp_regcomp) } #endif - if (!pm->op_pmregexp->prelen && PL_curpm) + if (!PM_GETRE(pm)->prelen && PL_curpm) pm = PL_curpm; - else if (strEQ("\\s+", pm->op_pmregexp->precomp)) + else if (strEQ("\\s+", PM_GETRE(pm)->precomp)) pm->op_pmflags |= PMf_WHITE; + else + pm->op_pmflags &= ~PMf_WHITE; /* XXX runtime compiled output needs to move to the pad */ if (pm->op_pmflags & PMf_KEEP) { pm->op_private &= ~OPpRUNTIME; /* no point compiling again */ -#if !defined(USE_ITHREADS) && !defined(USE_THREADS) +#if !defined(USE_ITHREADS) && !defined(USE_5005THREADS) /* XXX can't change the optree at runtime either */ cLOGOP->op_first->op_next = PL_op->op_next; #endif @@ -227,9 +236,9 @@ PP(pp_substcont) I32 i; if (SvTYPE(sv) < SVt_PVMG) (void)SvUPGRADE(sv, SVt_PVMG); - if (!(mg = mg_find(sv, 'g'))) { - sv_magic(sv, Nullsv, 'g', Nullch, 0); - mg = mg_find(sv, 'g'); + if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) { + sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0); + mg = mg_find(sv, PERL_MAGIC_regex_global); } i = m - orig; if (DO_UTF8(sv)) @@ -312,18 +321,18 @@ PP(pp_formline) register char *s; register char *send; register I32 arg; - register SV *sv; - char *item; - I32 itemsize; - I32 fieldsize; + register SV *sv = Nullsv; + char *item = Nullch; + I32 itemsize = 0; + I32 fieldsize = 0; I32 lines = 0; bool chopspace = (strchr(PL_chopset, ' ') != Nullch); - char *chophere; - char *linemark; + char *chophere = Nullch; + char *linemark = Nullch; NV value; - bool gotsome; + bool gotsome = FALSE; STRLEN len; - STRLEN fudge = SvCUR(tmpForm) * (IN_BYTE ? 1 : 3) + 1; + STRLEN fudge = SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1; bool item_is_utf = FALSE; if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) { @@ -373,7 +382,7 @@ PP(pp_formline) PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg); else PerlIO_printf(Perl_debug_log, "%-16s\n", name); - } ) + } ); switch (*fpc++) { case FF_LINEMARK: linemark = t; @@ -771,7 +780,7 @@ PP(pp_grepstart) ENTER; /* enter outer scope */ SAVETMPS; - /* SAVE_DEFSV does *not* suffice here for USE_THREADS */ + /* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */ SAVESPTR(DEFSV); ENTER; /* enter inner scope */ SAVEVPTR(PL_curpm); @@ -887,7 +896,7 @@ PP(pp_sort) register I32 max; HV *stash; GV *gv; - CV *cv; + CV *cv = 0; I32 gimme = GIMME; OP* nextop = PL_op->op_next; I32 overloading = 0; @@ -985,7 +994,7 @@ PP(pp_sort) PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV); PL_sortstash = stash; } -#ifdef USE_THREADS +#ifdef USE_5005THREADS sv_lock((SV *)PL_firstgv); sv_lock((SV *)PL_secondgv); #endif @@ -1007,10 +1016,10 @@ PP(pp_sort) /* This is mostly copied from pp_entersub */ AV *av = (AV*)PL_curpad[0]; -#ifndef USE_THREADS +#ifndef USE_5005THREADS cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ cx->blk_sub.oldcurpad = PL_curpad; cx->blk_sub.argarray = av; } @@ -1031,7 +1040,7 @@ PP(pp_sort) ? ( (PL_op->op_private & OPpSORT_INTEGER) ? ( overloading ? amagic_i_ncmp : sv_i_ncmp) : ( overloading ? amagic_ncmp : sv_ncmp)) - : ( (PL_op->op_private & OPpLOCALE) + : ( IN_LOCALE_RUNTIME ? ( overloading ? amagic_cmp_locale : sv_cmp_locale_static) @@ -1079,7 +1088,7 @@ PP(pp_flip) if (PL_op->op_private & OPpFLIP_LINENUM) { struct io *gp_io; flip = PL_last_in_gv - && (gp_io = GvIOp(PL_last_in_gv)) + && (gp_io = GvIO(PL_last_in_gv)) && SvIV(sv) == (IV)IoLINES(gp_io); } else { flip = SvTRUE(sv); @@ -1160,7 +1169,8 @@ PP(pp_flop) SV *targ = PAD_SV(cUNOP->op_first->op_targ); sv_inc(targ); if ((PL_op->op_private & OPpFLIP_LINENUM) - ? (PL_last_in_gv && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv))) + ? (GvIO(PL_last_in_gv) + && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv))) : SvTRUE(sv) ) { sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0); sv_catpv(targ, "E0"); @@ -1185,27 +1195,27 @@ S_dopoptolabel(pTHX_ char *label) case CXt_SUBST: if (ckWARN(WARN_EXITING)) Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s", - PL_op_name[PL_op->op_type]); + OP_NAME(PL_op)); break; case CXt_SUB: if (ckWARN(WARN_EXITING)) Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s", - PL_op_name[PL_op->op_type]); + OP_NAME(PL_op)); break; case CXt_FORMAT: if (ckWARN(WARN_EXITING)) Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s", - PL_op_name[PL_op->op_type]); + OP_NAME(PL_op)); break; case CXt_EVAL: if (ckWARN(WARN_EXITING)) Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s", - PL_op_name[PL_op->op_type]); + OP_NAME(PL_op)); break; case CXt_NULL: if (ckWARN(WARN_EXITING)) Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s", - PL_op_name[PL_op->op_type]); + OP_NAME(PL_op)); return -1; case CXt_LOOP: if (!cx->blk_loop.label || @@ -1320,27 +1330,27 @@ S_dopoptoloop(pTHX_ I32 startingblock) case CXt_SUBST: if (ckWARN(WARN_EXITING)) Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s", - PL_op_name[PL_op->op_type]); + OP_NAME(PL_op)); break; case CXt_SUB: if (ckWARN(WARN_EXITING)) Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s", - PL_op_name[PL_op->op_type]); + OP_NAME(PL_op)); break; case CXt_FORMAT: if (ckWARN(WARN_EXITING)) Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s", - PL_op_name[PL_op->op_type]); + OP_NAME(PL_op)); break; case CXt_EVAL: if (ckWARN(WARN_EXITING)) Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s", - PL_op_name[PL_op->op_type]); + OP_NAME(PL_op)); break; case CXt_NULL: if (ckWARN(WARN_EXITING)) Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s", - PL_op_name[PL_op->op_type]); + OP_NAME(PL_op)); return -1; case CXt_LOOP: DEBUG_l( Perl_deb(aTHX_ "(Found loop #%ld)\n", (long)i)); @@ -1433,10 +1443,6 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) } else { sv_setpvn(ERRSV, message, msglen); - if (PL_hints & HINT_UTF8) - SvUTF8_on(ERRSV); - else - SvUTF8_off(ERRSV); } } else @@ -1545,7 +1551,7 @@ PP(pp_caller) if (MAXARG) count = POPi; - EXTEND(SP, 10); + for (;;) { /* we may be in a higher stacklevel, so dig down deeper */ while (cxix < 0 && top_si->si_type != PERLSI_MAIN) { @@ -1554,8 +1560,10 @@ PP(pp_caller) cxix = dopoptosub_at(ccstack, top_si->si_cxix); } if (cxix < 0) { - if (GIMME != G_ARRAY) + if (GIMME != G_ARRAY) { + EXTEND(SP, 1); RETPUSHUNDEF; + } RETURN; } if (PL_DBsub && cxix >= 0 && @@ -1577,6 +1585,7 @@ PP(pp_caller) stashname = CopSTASHPV(cx->blk_oldcop); if (GIMME != G_ARRAY) { + EXTEND(SP, 1); if (!stashname) PUSHs(&PL_sv_undef); else { @@ -1587,6 +1596,8 @@ PP(pp_caller) RETURN; } + EXTEND(SP, 10); + if (!stashname) PUSHs(&PL_sv_undef); else @@ -1759,14 +1770,14 @@ PP(pp_enteriter) ENTER; SAVETMPS; -#ifdef USE_THREADS +#ifdef USE_5005THREADS if (PL_op->op_flags & OPf_SPECIAL) { svp = &THREADSV(PL_op->op_targ); /* per-thread variable */ SAVEGENERICSV(*svp); *svp = NEWSV(0,0); } else -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ if (PL_op->op_targ) { #ifndef USE_ITHREADS svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */ @@ -2241,10 +2252,10 @@ PP(pp_goto) EXTEND(PL_stack_sp, items); /* @_ could have been extended. */ Copy(AvARRAY(av), PL_stack_sp, items, SV*); PL_stack_sp += items; -#ifndef USE_THREADS +#ifndef USE_5005THREADS SvREFCNT_dec(GvAV(PL_defgv)); GvAV(PL_defgv) = cx->blk_sub.savearray; -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ /* abandon @_ if it got reified */ if (AvREAL(av)) { (void)sv_2mortal((SV*)av); /* delay until return */ @@ -2256,7 +2267,7 @@ PP(pp_goto) } else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */ AV* av; -#ifdef USE_THREADS +#ifdef USE_5005THREADS av = (AV*)PL_curpad[0]; #else av = GvAV(PL_defgv); @@ -2368,7 +2379,7 @@ PP(pp_goto) svp = AvARRAY(padlist); } } -#ifdef USE_THREADS +#ifdef USE_5005THREADS if (!cx->blk_sub.hasargs) { AV* av = (AV*)PL_curpad[0]; @@ -2381,20 +2392,20 @@ PP(pp_goto) PUTBACK ; } } -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ SAVEVPTR(PL_curpad); PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); -#ifndef USE_THREADS +#ifndef USE_5005THREADS if (cx->blk_sub.hasargs) -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ { AV* av = (AV*)PL_curpad[0]; SV** ary; -#ifndef USE_THREADS +#ifndef USE_5005THREADS cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ cx->blk_sub.oldcurpad = PL_curpad; cx->blk_sub.argarray = av; ++mark; @@ -2794,7 +2805,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) return rop; } -/* With USE_THREADS, eval_owner must be held on entry to doeval */ +/* With USE_5005THREADS, eval_owner must be held on entry to doeval */ STATIC OP * S_doeval(pTHX_ int gimme, OP** startop) { @@ -2835,11 +2846,14 @@ S_doeval(pTHX_ int gimme, OP** startop) PL_compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)PL_compcv, SVt_PVCV); CvEVAL_on(PL_compcv); -#ifdef USE_THREADS + assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL); + cxstack[cxstack_ix].blk_eval.cv = PL_compcv; + +#ifdef USE_5005THREADS CvOWNER(PL_compcv) = 0; New(666, CvMUTEXP(PL_compcv), 1, perl_mutex); MUTEX_INIT(CvMUTEXP(PL_compcv)); -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ PL_comppad = newAV(); av_push(PL_comppad, Nullsv); @@ -2848,11 +2862,11 @@ S_doeval(pTHX_ int gimme, OP** startop) PL_comppad_name_fill = 0; PL_min_intro_pending = 0; PL_padix = 0; -#ifdef USE_THREADS +#ifdef USE_5005THREADS av_store(PL_comppad_name, 0, newSVpvn("@_", 2)); PL_curpad[0] = (SV*)newAV(); SvPADMY_on(PL_curpad[0]); /* XXX Needed? */ -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ comppadlist = newAV(); AvREAL_off(comppadlist); @@ -2866,7 +2880,7 @@ S_doeval(pTHX_ int gimme, OP** startop) CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller); } - SAVEFREESV(PL_compcv); + SAVEMORTALIZESV(PL_compcv); /* must remain until end of current statement */ /* make sure we compile in the right package */ @@ -2926,12 +2940,12 @@ S_doeval(pTHX_ int gimme, OP** startop) } SvREFCNT_dec(PL_rs); PL_rs = SvREFCNT_inc(PL_nrs); -#ifdef USE_THREADS +#ifdef USE_5005THREADS MUTEX_LOCK(&PL_eval_mutex); PL_eval_owner = 0; COND_SIGNAL(&PL_eval_cond); MUTEX_UNLOCK(&PL_eval_mutex); -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ RETPUSHUNDEF; } SvREFCNT_dec(PL_rs); @@ -2970,12 +2984,12 @@ S_doeval(pTHX_ int gimme, OP** startop) SP = PL_stack_base + POPMARK; /* pop original mark */ PL_op = saveop; /* The caller may need it. */ PL_lex_state = LEX_NOTPARSING; /* $^S needs this. */ -#ifdef USE_THREADS +#ifdef USE_5005THREADS MUTEX_LOCK(&PL_eval_mutex); PL_eval_owner = 0; COND_SIGNAL(&PL_eval_cond); MUTEX_UNLOCK(&PL_eval_mutex); -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ RETURNOP(PL_eval_start); } @@ -3019,7 +3033,7 @@ PP(pp_require) SV *sv; char *name; STRLEN len; - char *tryname; + char *tryname = Nullch; SV *namesv = Nullsv; SV** svp; I32 gimme = GIMME_V; @@ -3032,7 +3046,7 @@ PP(pp_require) sv = POPs; if (SvNIOKp(sv)) { - if (SvPOK(sv) && SvNOK(sv)) { /* require v5.6.1 */ + if (SvPOK(sv) && SvNOK(sv) && SvNV(sv)) { /* require v5.6.1 */ UV rev = 0, ver = 0, sver = 0; STRLEN len; U8 *s = (U8*)SvPVX(sv); @@ -3139,12 +3153,14 @@ trylocal: { int count; SV *loader = dirsv; - if (SvTYPE(SvRV(loader)) == SVt_PVAV) { + if (SvTYPE(SvRV(loader)) == SVt_PVAV + && !sv_isobject(loader)) + { loader = *av_fetch((AV *)SvRV(loader), 0, TRUE); } Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s", - PTR2UV(SvANY(loader)), name); + PTR2UV(SvRV(dirsv)), name); tryname = SvPVX(namesv); tryrsfp = 0; @@ -3352,14 +3368,14 @@ trylocal: { CopLINE_set(&PL_compiling, 0); PUTBACK; -#ifdef USE_THREADS +#ifdef USE_5005THREADS MUTEX_LOCK(&PL_eval_mutex); if (PL_eval_owner && PL_eval_owner != thr) while (PL_eval_owner) COND_WAIT(&PL_eval_cond, &PL_eval_mutex); PL_eval_owner = thr; MUTEX_UNLOCK(&PL_eval_mutex); -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ return DOCATCH(doeval(gimme, NULL)); } @@ -3436,14 +3452,14 @@ PP(pp_entereval) if (PERLDB_LINE && PL_curstash != PL_debstash) save_lines(CopFILEAV(&PL_compiling), PL_linestr); PUTBACK; -#ifdef USE_THREADS +#ifdef USE_5005THREADS MUTEX_LOCK(&PL_eval_mutex); if (PL_eval_owner && PL_eval_owner != thr) while (PL_eval_owner) COND_WAIT(&PL_eval_cond, &PL_eval_mutex); PL_eval_owner = thr; MUTEX_UNLOCK(&PL_eval_mutex); -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ ret = doeval(gimme, NULL); if (PERLDB_INTER && was != PL_sub_generation /* Some subs defined here. */ && ret != PL_op->op_next) { /* Successive compilation. */ @@ -3592,14 +3608,14 @@ S_doparseform(pTHX_ SV *sv) STRLEN len; register char *s = SvPV_force(sv, len); register char *send = s + len; - register char *base; + register char *base = Nullch; register I32 skipspaces = 0; - bool noblank; - bool repeat; + bool noblank = FALSE; + bool repeat = FALSE; bool postspace = FALSE; U16 *fops; register U16 *fpc; - U16 *linepc; + U16 *linepc = 0; register I32 arg; bool ischop; @@ -3778,7 +3794,7 @@ S_doparseform(pTHX_ SV *sv) } Copy(fops, s, arg, U16); Safefree(fops); - sv_magic(sv, Nullsv, 'f', Nullch, 0); + sv_magic(sv, Nullsv, PERL_MAGIC_fm, Nullch, 0); SvCOMPILED_on(sv); } @@ -4187,7 +4203,7 @@ sortcv_stacked(pTHXo_ SV *a, SV *b) I32 result; AV *av; -#ifdef USE_THREADS +#ifdef USE_5005THREADS av = (AV*)PL_curpad[0]; #else av = GvAV(PL_defgv);