X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=7a1ad799b8508bbf41b51ac780f2bbb5582c7058;hb=9d116dd7c895b17badf4ad422ae44da0c4df7bc2;hp=db626a1c989e2362c2134e116f835a6b1db08155;hpb=20408e3ccf502b6ce4033d8203710405ec9ef8f6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index db626a1..7a1ad79 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -25,6 +25,10 @@ #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) +#ifdef PERL_OBJECT +#define CALLOP this->*PL_op +#else +#define CALLOP *PL_op static OP *docatch _((OP *o)); static OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit)); static void doparseform _((SV *sv)); @@ -32,12 +36,12 @@ static I32 dopoptoeval _((I32 startingblock)); static I32 dopoptolabel _((char *label)); static I32 dopoptoloop _((I32 startingblock)); static I32 dopoptosub _((I32 startingblock)); +static I32 dopoptosub_at _((PERL_CONTEXT *cxstk, I32 startingblock)); static void save_lines _((AV *array, SV *sv)); static I32 sortcv _((SV *a, SV *b)); static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b))); static OP *doeval _((int gimme, OP** startop)); - -static I32 sortcxix; +#endif PP(pp_wantarray) { @@ -64,7 +68,16 @@ PP(pp_regcmaybe) return NORMAL; } -PP(pp_regcomp) { +PP(pp_regcreset) +{ + /* XXXX Should store the old value to allow for tie/overload - and + restore in regcomp, where marked with XXXX. */ + PL_reginterp_cnt = 0; + return NORMAL; +} + +PP(pp_regcomp) +{ djSP; register PMOP *pm = (PMOP*)cLOGOP->op_other; register char *t; @@ -73,12 +86,12 @@ PP(pp_regcomp) { MAGIC *mg = Null(MAGIC*); tmpstr = POPs; - if(SvROK(tmpstr)) { + if (SvROK(tmpstr)) { SV *sv = SvRV(tmpstr); if(SvMAGICAL(sv)) mg = mg_find(sv, 'r'); } - if(mg) { + if (mg) { regexp *re = (regexp *)mg->mg_obj; ReREFCNT_dec(pm->op_pmregexp); pm->op_pmregexp = ReREFCNT_inc(re); @@ -95,20 +108,33 @@ PP(pp_regcomp) { ReREFCNT_dec(pm->op_pmregexp); pm->op_pmregexp = Null(REGEXP*); /* crucial if regcomp aborts */ } + if (PL_op->op_flags & OPf_SPECIAL) + PL_reginterp_cnt = I32_MAX; /* Mark as safe. */ pm->op_pmflags = pm->op_pmpermflags; /* reset case sensitivity */ - pm->op_pmregexp = pregcomp(t, t + len, pm); + pm->op_pmregexp = CALLREGCOMP(t, t + len, pm); + PL_reginterp_cnt = 0; /* XXXX Be extra paranoid - needed + inside tie/overload accessors. */ } } - if (!pm->op_pmregexp->prelen && curpm) - pm = curpm; +#ifndef INCOMPLETE_TAINTS + if (PL_tainting) { + if (PL_tainted) + pm->op_pmdynflags |= PMdf_TAINTED; + else + pm->op_pmdynflags &= ~PMdf_TAINTED; + } +#endif + + if (!pm->op_pmregexp->prelen && PL_curpm) + pm = PL_curpm; else if (strEQ("\\s+", pm->op_pmregexp->precomp)) pm->op_pmflags |= PMf_WHITE; if (pm->op_pmflags & PMf_KEEP) { pm->op_private &= ~OPpRUNTIME; /* no point compiling again */ - cLOGOP->op_first->op_next = op->op_next; + cLOGOP->op_first->op_next = PL_op->op_next; } RETURN; } @@ -130,19 +156,19 @@ PP(pp_substcont) if (cx->sb_iters > cx->sb_maxiters) DIE("Substitution loop"); - if (!cx->sb_rxtainted) - cx->sb_rxtainted = SvTAINTED(TOPs); + if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs)) + cx->sb_rxtainted |= 2; sv_catsv(dstr, POPs); /* Are we done */ - if (cx->sb_once || !regexec_flags(rx, s, cx->sb_strend, orig, + if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig, s == m, Nullsv, NULL, cx->sb_safebase ? 0 : REXEC_COPY_STR)) { SV *targ = cx->sb_targ; sv_catpvn(dstr, s, cx->sb_strend - s); - TAINT_IF(cx->sb_rxtainted || RX_MATCH_TAINTED(rx)); + cx->sb_rxtainted |= RX_MATCH_TAINTED(rx); (void)SvOOK_off(targ); Safefree(SvPVX(targ)); @@ -151,11 +177,15 @@ PP(pp_substcont) SvLEN_set(targ, SvLEN(dstr)); SvPVX(dstr) = 0; sv_free(dstr); + + TAINT_IF(cx->sb_rxtainted & 1); + PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1))); + (void)SvPOK_only(targ); + TAINT_IF(cx->sb_rxtainted); SvSETMAGIC(targ); SvTAINT(targ); - PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1))); LEAVE_SCOPE(cx->sb_oldsave); POPSUBST(cx); RETURNOP(pm->op_next); @@ -239,7 +269,7 @@ rxres_free(void **rsp) PP(pp_formline) { djSP; dMARK; dORIGMARK; - register SV *form = *++MARK; + register SV *tmpForm = *++MARK; register U16 *fpc; register char *t; register char *f; @@ -251,24 +281,24 @@ PP(pp_formline) I32 itemsize; I32 fieldsize; I32 lines = 0; - bool chopspace = (strchr(chopset, ' ') != Nullch); + bool chopspace = (strchr(PL_chopset, ' ') != Nullch); char *chophere; char *linemark; double value; bool gotsome; STRLEN len; - if (!SvMAGICAL(form) || !SvCOMPILED(form)) { - SvREADONLY_off(form); - doparseform(form); + if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) { + SvREADONLY_off(tmpForm); + doparseform(tmpForm); } - SvPV_force(formtarget, len); - t = SvGROW(formtarget, len + SvCUR(form) + 1); /* XXX SvCUR bad */ + SvPV_force(PL_formtarget, len); + t = SvGROW(PL_formtarget, len + SvCUR(tmpForm) + 1); /* XXX SvCUR bad */ t += len; - f = SvPV(form, len); + f = SvPV(tmpForm, len); /* need to jump to the next word */ - s = f + len + WORD_ALIGN - SvCUR(form) % WORD_ALIGN; + s = f + len + WORD_ALIGN - SvCUR(tmpForm) % WORD_ALIGN; fpc = (U16*)s; @@ -325,8 +355,8 @@ PP(pp_formline) if (MARK < SP) sv = *++MARK; else { - sv = &sv_no; - if (dowarn) + sv = &PL_sv_no; + if (PL_dowarn) warn("Not enough format arguments"); } break; @@ -374,7 +404,7 @@ PP(pp_formline) else { if (*s & ~31) gotsome = TRUE; - if (strchr(chopset, *s)) + if (strchr(PL_chopset, *s)) chophere = s + 1; } s++; @@ -406,15 +436,13 @@ PP(pp_formline) arg = itemsize; s = item; while (arg--) { -#if 'z' - 'a' != 25 +#ifdef EBCDIC int ch = *t++ = *s++; - if (!iscntrl(ch)) - t[-1] = ' '; + if (iscntrl(ch)) #else if ( !((*t++ = *s++) & ~31) ) - t[-1] = ' '; #endif - + t[-1] = ' '; } break; @@ -441,10 +469,10 @@ PP(pp_formline) lines++; } } - SvCUR_set(formtarget, t - SvPVX(formtarget)); - sv_catpvn(formtarget, item, itemsize); - SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1); - t = SvPVX(formtarget) + SvCUR(formtarget); + SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); + sv_catpvn(PL_formtarget, item, itemsize); + SvGROW(PL_formtarget, SvCUR(PL_formtarget) + SvCUR(tmpForm) + 1); + t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget); } break; @@ -482,14 +510,14 @@ PP(pp_formline) if (gotsome) { if (arg) { /* repeat until fields exhausted? */ *t = '\0'; - SvCUR_set(formtarget, t - SvPVX(formtarget)); - lines += FmLINES(formtarget); + SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); + lines += FmLINES(PL_formtarget); if (lines == 200) { arg = t - linemark; if (strnEQ(linemark, linemark - arg, arg)) DIE("Runaway format"); } - FmLINES(formtarget) = lines; + FmLINES(PL_formtarget) = lines; SP = ORIGMARK; RETURNOP(cLISTOP->op_first); } @@ -510,7 +538,7 @@ PP(pp_formline) } s = t - 3; if (strnEQ(s," ",3)) { - while (s > SvPVX(formtarget) && isSPACE(s[-1])) + while (s > SvPVX(PL_formtarget) && isSPACE(s[-1])) s--; } *s++ = '.'; @@ -521,8 +549,8 @@ PP(pp_formline) case FF_END: *t = '\0'; - SvCUR_set(formtarget, t - SvPVX(formtarget)); - FmLINES(formtarget) += lines; + SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); + FmLINES(PL_formtarget) += lines; SP = ORIGMARK; RETPUSHYES; } @@ -534,13 +562,13 @@ PP(pp_grepstart) djSP; SV *src; - if (stack_base + *markstack_ptr == SP) { + if (PL_stack_base + *PL_markstack_ptr == SP) { (void)POPMARK; if (GIMME_V == G_SCALAR) - XPUSHs(&sv_no); - RETURNOP(op->op_next->op_next); + XPUSHs(&PL_sv_no); + RETURNOP(PL_op->op_next->op_next); } - stack_sp = stack_base + *markstack_ptr + 1; + PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1; pp_pushmark(ARGS); /* push dst */ pp_pushmark(ARGS); /* push src */ ENTER; /* enter outer scope */ @@ -550,19 +578,19 @@ PP(pp_grepstart) /* SAVE_DEFSV does *not* suffice here */ save_sptr(&THREADSV(0)); #else - SAVESPTR(GvSV(defgv)); + SAVESPTR(GvSV(PL_defgv)); #endif /* USE_THREADS */ ENTER; /* enter inner scope */ - SAVESPTR(curpm); + SAVESPTR(PL_curpm); - src = stack_base[*markstack_ptr]; + src = PL_stack_base[*PL_markstack_ptr]; SvTEMP_off(src); DEFSV = src; PUTBACK; - if (op->op_type == OP_MAPSTART) + if (PL_op->op_type == OP_MAPSTART) pp_pushmark(ARGS); /* push top */ - return ((LOGOP*)op->op_next)->op_other; + return ((LOGOP*)PL_op->op_next)->op_other; } PP(pp_mapstart) @@ -573,27 +601,27 @@ PP(pp_mapstart) PP(pp_mapwhile) { djSP; - I32 diff = (SP - stack_base) - *markstack_ptr; + I32 diff = (SP - PL_stack_base) - *PL_markstack_ptr; I32 count; I32 shift; SV** src; SV** dst; - ++markstack_ptr[-1]; + ++PL_markstack_ptr[-1]; if (diff) { - if (diff > markstack_ptr[-1] - markstack_ptr[-2]) { - shift = diff - (markstack_ptr[-1] - markstack_ptr[-2]); - count = (SP - stack_base) - markstack_ptr[-1] + 2; + if (diff > PL_markstack_ptr[-1] - PL_markstack_ptr[-2]) { + shift = diff - (PL_markstack_ptr[-1] - PL_markstack_ptr[-2]); + count = (SP - PL_stack_base) - PL_markstack_ptr[-1] + 2; EXTEND(SP,shift); src = SP; dst = (SP += shift); - markstack_ptr[-1] += shift; - *markstack_ptr += shift; + PL_markstack_ptr[-1] += shift; + *PL_markstack_ptr += shift; while (--count) *dst-- = *src--; } - dst = stack_base + (markstack_ptr[-2] += diff) - 1; + dst = PL_stack_base + (PL_markstack_ptr[-2] += diff) - 1; ++diff; while (--diff) *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs); @@ -601,16 +629,16 @@ PP(pp_mapwhile) LEAVE; /* exit inner scope */ /* All done yet? */ - if (markstack_ptr[-1] > *markstack_ptr) { + if (PL_markstack_ptr[-1] > *PL_markstack_ptr) { I32 items; I32 gimme = GIMME_V; (void)POPMARK; /* pop top */ LEAVE; /* exit outer scope */ (void)POPMARK; /* pop src */ - items = --*markstack_ptr - markstack_ptr[-1]; + items = --*PL_markstack_ptr - PL_markstack_ptr[-1]; (void)POPMARK; /* pop dst */ - SP = stack_base + POPMARK; /* pop original mark */ + SP = PL_stack_base + POPMARK; /* pop original mark */ if (gimme == G_SCALAR) { dTARGET; XPUSHi(items); @@ -623,9 +651,9 @@ PP(pp_mapwhile) SV *src; ENTER; /* enter inner scope */ - SAVESPTR(curpm); + SAVESPTR(PL_curpm); - src = stack_base[markstack_ptr[-1]]; + src = PL_stack_base[PL_markstack_ptr[-1]]; SvTEMP_off(src); DEFSV = src; @@ -633,7 +661,6 @@ PP(pp_mapwhile) } } - PP(pp_sort) { djSP; dMARK; dORIGMARK; @@ -644,7 +671,7 @@ PP(pp_sort) GV *gv; CV *cv; I32 gimme = GIMME; - OP* nextop = op->op_next; + OP* nextop = PL_op->op_next; if (gimme != G_ARRAY) { SP = MARK; @@ -652,14 +679,14 @@ PP(pp_sort) } ENTER; - SAVEPPTR(sortcop); - if (op->op_flags & OPf_STACKED) { - if (op->op_flags & OPf_SPECIAL) { + SAVEPPTR(PL_sortcop); + if (PL_op->op_flags & OPf_STACKED) { + if (PL_op->op_flags & OPf_SPECIAL) { OP *kid = cLISTOP->op_first->op_sibling; /* pass pushmark */ kid = kUNOP->op_first; /* pass rv2gv */ kid = kUNOP->op_first; /* pass leave */ - sortcop = kid->op_next; - stash = curcop->cop_stash; + PL_sortcop = kid->op_next; + stash = PL_curcop->cop_stash; } else { cv = sv_2cv(*++MARK, &stash, &gv, 0); @@ -679,17 +706,17 @@ PP(pp_sort) } DIE("Not a CODE reference in sort"); } - sortcop = CvSTART(cv); + PL_sortcop = CvSTART(cv); SAVESPTR(CvROOT(cv)->op_ppaddr); CvROOT(cv)->op_ppaddr = ppaddr[OP_NULL]; - SAVESPTR(curpad); - curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); + SAVESPTR(PL_curpad); + PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); } } else { - sortcop = Nullop; - stash = curcop->cop_stash; + PL_sortcop = Nullop; + stash = PL_curcop->cop_stash; } up = myorigmark + 1; @@ -697,13 +724,13 @@ PP(pp_sort) /*SUPPRESS 560*/ if (*up = *++MARK) { /* Weed out nulls. */ SvTEMP_off(*up); - if (!sortcop && !SvPOK(*up)) - (void)sv_2pv(*up, &na); + if (!PL_sortcop && !SvPOK(*up)) + (void)sv_2pv(*up, &PL_na); up++; } } max = --up - myorigmark; - if (sortcop) { + if (PL_sortcop) { if (max > 1) { PERL_CONTEXT *cx; SV** newsp; @@ -713,18 +740,18 @@ PP(pp_sort) SAVEOP(); CATCH_SET(TRUE); - PUSHSTACK(SI_SORT); - if (sortstash != stash) { - firstgv = gv_fetchpv("a", TRUE, SVt_PV); - secondgv = gv_fetchpv("b", TRUE, SVt_PV); - sortstash = stash; + PUSHSTACKi(PERLSI_SORT); + if (PL_sortstash != stash) { + PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV); + PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV); + PL_sortstash = stash; } - SAVESPTR(GvSV(firstgv)); - SAVESPTR(GvSV(secondgv)); + SAVESPTR(GvSV(PL_firstgv)); + SAVESPTR(GvSV(PL_secondgv)); - PUSHBLOCK(cx, CXt_NULL, stack_base); - if (!(op->op_flags & OPf_SPECIAL)) { + PUSHBLOCK(cx, CXt_NULL, PL_stack_base); + if (!(PL_op->op_flags & OPf_SPECIAL)) { bool hasargs = FALSE; cx->cx_type = CXt_SUB; cx->blk_gimme = G_SCALAR; @@ -732,12 +759,11 @@ PP(pp_sort) if (!CvDEPTH(cv)) (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */ } - sortcxix = cxstack_ix; + PL_sortcxix = cxstack_ix; + qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv)); - qsortsv(myorigmark+1, max, sortcv); - - POPBLOCK(cx,curpm); - POPSTACK(); + POPBLOCK(cx,PL_curpm); + POPSTACK; CATCH_SET(oldcatch); } } @@ -745,11 +771,13 @@ PP(pp_sort) if (max > 1) { MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */ qsortsv(ORIGMARK+1, max, - (op->op_private & OPpLOCALE) ? sv_cmp_locale : sv_cmp); + (PL_op->op_private & OPpLOCALE) + ? FUNC_NAME_TO_PTR(sv_cmp_locale) + : FUNC_NAME_TO_PTR(sv_cmp)); } } LEAVE; - stack_sp = ORIGMARK + max; + PL_stack_sp = ORIGMARK + max; return nextop; } @@ -759,7 +787,7 @@ PP(pp_range) { if (GIMME == G_ARRAY) return cCONDOP->op_true; - return SvTRUEx(PAD_SV(op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true; + return SvTRUEx(PAD_SV(PL_op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true; } PP(pp_flip) @@ -771,13 +799,13 @@ PP(pp_flip) } else { dTOPss; - SV *targ = PAD_SV(op->op_targ); + SV *targ = PAD_SV(PL_op->op_targ); - if ((op->op_private & OPpFLIP_LINENUM) - ? last_in_gv && SvIV(sv) == IoLINES(GvIOp(last_in_gv)) + if ((PL_op->op_private & OPpFLIP_LINENUM) + ? (PL_last_in_gv && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv))) : SvTRUE(sv) ) { sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1); - if (op->op_flags & OPf_SPECIAL) { + if (PL_op->op_flags & OPf_SPECIAL) { sv_setiv(targ, 1); SETs(targ); RETURN; @@ -807,6 +835,8 @@ PP(pp_flop) if (SvNIOKp(left) || !SvPOKp(left) || (looks_like_number(left) && *SvPVX(left) != '0') ) { + if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX) + croak("Range iterator outside integer range"); i = SvIV(left); max = SvIV(right); if (max >= i) { @@ -824,22 +854,22 @@ PP(pp_flop) char *tmps = SvPV(final, len); sv = sv_mortalcopy(left); - while (!SvNIOKp(sv) && SvCUR(sv) <= len && - strNE(SvPVX(sv),tmps) ) { + SvPV_force(sv,PL_na); + while (!SvNIOKp(sv) && SvCUR(sv) <= len) { XPUSHs(sv); + if (strEQ(SvPVX(sv),tmps)) + break; sv = sv_2mortal(newSVsv(sv)); sv_inc(sv); } - if (strEQ(SvPVX(sv),tmps)) - XPUSHs(sv); } } else { dTOPss; SV *targ = PAD_SV(cUNOP->op_first->op_targ); sv_inc(targ); - if ((op->op_private & OPpFLIP_LINENUM) - ? last_in_gv && SvIV(sv) == IoLINES(GvIOp(last_in_gv)) + if ((PL_op->op_private & OPpFLIP_LINENUM) + ? (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"); @@ -852,7 +882,7 @@ PP(pp_flop) /* Control. */ -static I32 +STATIC I32 dopoptolabel(char *label) { dTHR; @@ -863,20 +893,20 @@ dopoptolabel(char *label) cx = &cxstack[i]; switch (cx->cx_type) { case CXt_SUBST: - if (dowarn) - warn("Exiting substitution via %s", op_name[op->op_type]); + if (PL_dowarn) + warn("Exiting substitution via %s", op_name[PL_op->op_type]); break; case CXt_SUB: - if (dowarn) - warn("Exiting subroutine via %s", op_name[op->op_type]); + if (PL_dowarn) + warn("Exiting subroutine via %s", op_name[PL_op->op_type]); break; case CXt_EVAL: - if (dowarn) - warn("Exiting eval via %s", op_name[op->op_type]); + if (PL_dowarn) + warn("Exiting eval via %s", op_name[PL_op->op_type]); break; case CXt_NULL: - if (dowarn) - warn("Exiting pseudo-block via %s", op_name[op->op_type]); + if (PL_dowarn) + warn("Exiting pseudo-block via %s", op_name[PL_op->op_type]); return -1; case CXt_LOOP: if (!cx->blk_loop.label || @@ -910,25 +940,34 @@ block_gimme(void) return G_VOID; switch (cxstack[cxix].blk_gimme) { + case G_VOID: + return G_VOID; case G_SCALAR: return G_SCALAR; case G_ARRAY: return G_ARRAY; default: croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme); - case G_VOID: - return G_VOID; + /* NOTREACHED */ + return 0; } } -static I32 +STATIC I32 dopoptosub(I32 startingblock) { dTHR; + return dopoptosub_at(cxstack, startingblock); +} + +STATIC I32 +dopoptosub_at(PERL_CONTEXT *cxstk, I32 startingblock) +{ + dTHR; I32 i; register PERL_CONTEXT *cx; for (i = startingblock; i >= 0; i--) { - cx = &cxstack[i]; + cx = &cxstk[i]; switch (cx->cx_type) { default: continue; @@ -941,7 +980,7 @@ dopoptosub(I32 startingblock) return i; } -static I32 +STATIC I32 dopoptoeval(I32 startingblock) { dTHR; @@ -960,7 +999,7 @@ dopoptoeval(I32 startingblock) return i; } -static I32 +STATIC I32 dopoptoloop(I32 startingblock) { dTHR; @@ -970,20 +1009,20 @@ dopoptoloop(I32 startingblock) cx = &cxstack[i]; switch (cx->cx_type) { case CXt_SUBST: - if (dowarn) - warn("Exiting substitution via %s", op_name[op->op_type]); + if (PL_dowarn) + warn("Exiting substitution via %s", op_name[PL_op->op_type]); break; case CXt_SUB: - if (dowarn) - warn("Exiting subroutine via %s", op_name[op->op_type]); + if (PL_dowarn) + warn("Exiting subroutine via %s", op_name[PL_op->op_type]); break; case CXt_EVAL: - if (dowarn) - warn("Exiting eval via %s", op_name[op->op_type]); + if (PL_dowarn) + warn("Exiting eval via %s", op_name[PL_op->op_type]); break; case CXt_NULL: - if (dowarn) - warn("Exiting pseudo-block via %s", op_name[op->op_type]); + if (PL_dowarn) + warn("Exiting pseudo-block via %s", op_name[PL_op->op_type]); return -1; case CXt_LOOP: DEBUG_l( deb("(Found loop #%ld)\n", (long)i)); @@ -1030,38 +1069,42 @@ OP * die_where(char *message) { dSP; - if (in_eval) { + if (PL_in_eval) { I32 cxix; register PERL_CONTEXT *cx; I32 gimme; SV **newsp; - if (in_eval & 4) { - SV **svp; - STRLEN klen = strlen(message); - - svp = hv_fetch(ERRHV, message, klen, TRUE); - if (svp) { - if (!SvIOK(*svp)) { - static char prefix[] = "\t(in cleanup) "; - SV *err = ERRSV; - sv_upgrade(*svp, SVt_IV); - (void)SvIOK_only(*svp); - if (!SvPOK(err)) - sv_setpv(err,""); - SvGROW(err, SvCUR(err)+sizeof(prefix)+klen); - sv_catpvn(err, prefix, sizeof(prefix)-1); - sv_catpvn(err, message, klen); + if (message) { + if (PL_in_eval & 4) { + SV **svp; + STRLEN klen = strlen(message); + + svp = hv_fetch(ERRHV, message, klen, TRUE); + if (svp) { + if (!SvIOK(*svp)) { + static char prefix[] = "\t(in cleanup) "; + SV *err = ERRSV; + sv_upgrade(*svp, SVt_IV); + (void)SvIOK_only(*svp); + if (!SvPOK(err)) + sv_setpv(err,""); + SvGROW(err, SvCUR(err)+sizeof(prefix)+klen); + sv_catpvn(err, prefix, sizeof(prefix)-1); + sv_catpvn(err, message, klen); + } + sv_inc(*svp); } - sv_inc(*svp); } + else + sv_setpv(ERRSV, message); } else - sv_setpv(ERRSV, message); - - while ((cxix = dopoptoeval(cxstack_ix)) < 0 && curstackinfo->si_prev) { + message = SvPVx(ERRSV, PL_na); + + while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) { dounwind(-1); - POPSTACK(); + POPSTACK; } if (cxix >= 0) { @@ -1070,7 +1113,7 @@ die_where(char *message) if (cxix < cxstack_ix) dounwind(cxix); - POPBLOCK(cx,curpm); + POPBLOCK(cx,PL_curpm); if (cx->cx_type != CXt_EVAL) { PerlIO_printf(PerlIO_stderr(), "panic: die %s", message); my_exit(1); @@ -1078,13 +1121,13 @@ die_where(char *message) POPEVAL(cx); if (gimme == G_SCALAR) - *++newsp = &sv_undef; - stack_sp = newsp; + *++newsp = &PL_sv_undef; + PL_stack_sp = newsp; LEAVE; if (optype == OP_REQUIRE) { - char* msg = SvPVx(ERRSV, na); + char* msg = SvPVx(ERRSV, PL_na); DIE("%s", *msg ? msg : "Compilation failed in require"); } return pop_return(); @@ -1129,6 +1172,8 @@ PP(pp_caller) djSP; register I32 cxix = dopoptosub(cxstack_ix); register PERL_CONTEXT *cx; + register PERL_CONTEXT *ccstack = cxstack; + PERL_SI *top_si = PL_curstackinfo; I32 dbcxix; I32 gimme; HV *hv; @@ -1139,31 +1184,38 @@ PP(pp_caller) count = POPi; EXTEND(SP, 6); for (;;) { + /* we may be in a higher stacklevel, so dig down deeper */ + while (cxix < 0 && top_si->si_type != PERLSI_MAIN) { + top_si = top_si->si_prev; + ccstack = top_si->si_cxstack; + cxix = dopoptosub_at(ccstack, top_si->si_cxix); + } if (cxix < 0) { if (GIMME != G_ARRAY) RETPUSHUNDEF; RETURN; } - if (DBsub && cxix >= 0 && - cxstack[cxix].blk_sub.cv == GvCV(DBsub)) + if (PL_DBsub && cxix >= 0 && + ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub)) count++; if (!count--) break; - cxix = dopoptosub(cxix - 1); + cxix = dopoptosub_at(ccstack, cxix - 1); } - cx = &cxstack[cxix]; - if (cxstack[cxix].cx_type == CXt_SUB) { - dbcxix = dopoptosub(cxix - 1); - /* We expect that cxstack[dbcxix] is CXt_SUB, anyway, the + + cx = &ccstack[cxix]; + if (ccstack[cxix].cx_type == CXt_SUB) { + dbcxix = dopoptosub_at(ccstack, cxix - 1); + /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the field below is defined for any cx. */ - if (DBsub && dbcxix >= 0 && cxstack[dbcxix].blk_sub.cv == GvCV(DBsub)) - cx = &cxstack[dbcxix]; + if (PL_DBsub && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) + cx = &ccstack[dbcxix]; } if (GIMME != G_ARRAY) { hv = cx->blk_oldcop->cop_stash; if (!hv) - PUSHs(&sv_undef); + PUSHs(&PL_sv_undef); else { dTARGET; sv_setpv(TARG, HvNAME(hv)); @@ -1174,16 +1226,16 @@ PP(pp_caller) hv = cx->blk_oldcop->cop_stash; if (!hv) - PUSHs(&sv_undef); + PUSHs(&PL_sv_undef); else PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0))); PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0))); PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line))); if (!MAXARG) RETURN; - if (cx->cx_type == CXt_SUB) { /* So is cxstack[dbcxix]. */ + if (cx->cx_type == CXt_SUB) { /* So is ccstack[dbcxix]. */ sv = NEWSV(49, 0); - gv_efullname3(sv, CvGV(cxstack[cxix].blk_sub.cv), Nullch); + gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch); PUSHs(sv_2mortal(sv)); PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs))); } @@ -1193,61 +1245,61 @@ PP(pp_caller) } gimme = (I32)cx->blk_gimme; if (gimme == G_VOID) - PUSHs(&sv_undef); + PUSHs(&PL_sv_undef); else PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY))); if (cx->cx_type == CXt_EVAL) { if (cx->blk_eval.old_op_type == OP_ENTEREVAL) { PUSHs(cx->blk_eval.cur_text); - PUSHs(&sv_no); + PUSHs(&PL_sv_no); } else if (cx->blk_eval.old_name) { /* Try blocks have old_name == 0. */ /* Require, put the name. */ PUSHs(sv_2mortal(newSVpv(cx->blk_eval.old_name, 0))); - PUSHs(&sv_yes); + PUSHs(&PL_sv_yes); } } else if (cx->cx_type == CXt_SUB && cx->blk_sub.hasargs && - curcop->cop_stash == debstash) + PL_curcop->cop_stash == PL_debstash) { AV *ary = cx->blk_sub.argarray; int off = AvARRAY(ary) - AvALLOC(ary); - if (!dbargs) { + if (!PL_dbargs) { GV* tmpgv; - dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE, + PL_dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE, SVt_PVAV))); GvMULTI_on(tmpgv); - AvREAL_off(dbargs); /* XXX Should be REIFY */ + AvREAL_off(PL_dbargs); /* XXX Should be REIFY */ } - if (AvMAX(dbargs) < AvFILLp(ary) + off) - av_extend(dbargs, AvFILLp(ary) + off); - Copy(AvALLOC(ary), AvARRAY(dbargs), AvFILLp(ary) + 1 + off, SV*); - AvFILLp(dbargs) = AvFILLp(ary) + off; + if (AvMAX(PL_dbargs) < AvFILLp(ary) + off) + av_extend(PL_dbargs, AvFILLp(ary) + off); + Copy(AvALLOC(ary), AvARRAY(PL_dbargs), AvFILLp(ary) + 1 + off, SV*); + AvFILLp(PL_dbargs) = AvFILLp(ary) + off; } RETURN; } -static I32 +STATIC I32 sortcv(SV *a, SV *b) { dTHR; - I32 oldsaveix = savestack_ix; - I32 oldscopeix = scopestack_ix; + I32 oldsaveix = PL_savestack_ix; + I32 oldscopeix = PL_scopestack_ix; I32 result; - GvSV(firstgv) = a; - GvSV(secondgv) = b; - stack_sp = stack_base; - op = sortcop; - runops(); - if (stack_sp != stack_base + 1) + GvSV(PL_firstgv) = a; + GvSV(PL_secondgv) = b; + PL_stack_sp = PL_stack_base; + PL_op = PL_sortcop; + CALLRUNOPS(); + if (PL_stack_sp != PL_stack_base + 1) croak("Sort subroutine didn't return single value"); - if (!SvNIOKp(*stack_sp)) + if (!SvNIOKp(*PL_stack_sp)) croak("Sort subroutine didn't return a numeric value"); - result = SvIV(*stack_sp); - while (scopestack_ix > oldscopeix) { + result = SvIV(*PL_stack_sp); + while (PL_scopestack_ix > oldscopeix) { LEAVE; } leave_scope(oldsaveix); @@ -1263,8 +1315,8 @@ PP(pp_reset) tmps = ""; else tmps = POPp; - sv_reset(tmps, curcop->cop_stash); - PUSHs(&sv_yes); + sv_reset(tmps, PL_curcop->cop_stash); + PUSHs(&PL_sv_yes); RETURN; } @@ -1275,12 +1327,12 @@ PP(pp_lineseq) PP(pp_dbstate) { - curcop = (COP*)op; + PL_curcop = (COP*)PL_op; TAINT_NOT; /* Each statement is presumed innocent */ - stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp; + PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; FREETMPS; - if (op->op_private || SvIV(DBsingle) || SvIV(DBsignal) || SvIV(DBtrace)) + if (PL_op->op_private || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace)) { djSP; register CV *cv; @@ -1289,30 +1341,30 @@ PP(pp_dbstate) I32 hasargs; GV *gv; - gv = DBgv; + gv = PL_DBgv; cv = GvCV(gv); if (!cv) DIE("No DB::DB routine defined"); - if (CvDEPTH(cv) >= 1 && !(debug & (1<<30))) /* don't do recursive DB::DB call */ + if (CvDEPTH(cv) >= 1 && !(PL_debug & (1<<30))) /* don't do recursive DB::DB call */ return NORMAL; ENTER; SAVETMPS; - SAVEI32(debug); + SAVEI32(PL_debug); SAVESTACK_POS(); - debug = 0; + PL_debug = 0; hasargs = 0; SPAGAIN; - push_return(op->op_next); + push_return(PL_op->op_next); PUSHBLOCK(cx, CXt_SUB, SP); PUSHSUB(cx); CvDEPTH(cv)++; (void)SvREFCNT_inc(cv); - SAVESPTR(curpad); - curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE)); + SAVESPTR(PL_curpad); + PL_curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE)); RETURNOP(CvSTART(cv)); } else @@ -1335,12 +1387,12 @@ PP(pp_enteriter) SAVETMPS; #ifdef USE_THREADS - if (op->op_flags & OPf_SPECIAL) - svp = save_threadsv(op->op_targ); /* per-thread variable */ + if (PL_op->op_flags & OPf_SPECIAL) + svp = save_threadsv(PL_op->op_targ); /* per-thread variable */ else #endif /* USE_THREADS */ - if (op->op_targ) { - svp = &curpad[op->op_targ]; /* "my" variable */ + if (PL_op->op_targ) { + svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */ SAVESPTR(*svp); } else { @@ -1353,12 +1405,26 @@ PP(pp_enteriter) PUSHBLOCK(cx, CXt_LOOP, SP); PUSHLOOP(cx, svp, MARK); - if (op->op_flags & OPf_STACKED) + if (PL_op->op_flags & OPf_STACKED) { cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs); + if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) { + dPOPss; + if (SvNIOKp(sv) || !SvPOKp(sv) || + (looks_like_number(sv) && *SvPVX(sv) != '0')) { + if (SvNV(sv) < IV_MIN || + SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX) + croak("Range iterator outside integer range"); + cx->blk_loop.iterix = SvIV(sv); + cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary); + } + else + cx->blk_loop.iterlval = newSVsv(sv); + } + } else { - cx->blk_loop.iterary = curstack; - AvFILLp(curstack) = SP - stack_base; - cx->blk_loop.iterix = MARK - stack_base; + cx->blk_loop.iterary = PL_curstack; + AvFILLp(PL_curstack) = SP - PL_stack_base; + cx->blk_loop.iterix = MARK - PL_stack_base; } RETURN; @@ -1401,7 +1467,7 @@ PP(pp_leaveloop) if (mark < SP) *++newsp = sv_mortalcopy(*SP); else - *++newsp = &sv_undef; + *++newsp = &PL_sv_undef; } else { while (mark < SP) { @@ -1413,7 +1479,7 @@ PP(pp_leaveloop) PUTBACK; POPLOOP2(); /* Stack values are safe: release loop vars ... */ - curpm = newpm; /* ... and pop $1 et al */ + PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; LEAVE; @@ -1433,12 +1499,12 @@ PP(pp_return) PMOP *newpm; I32 optype = 0; - if (curstackinfo->si_type == SI_SORT) { - if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) <= sortcxix) { - if (cxstack_ix > sortcxix) - dounwind(sortcxix); - AvARRAY(curstack)[1] = *SP; - stack_sp = stack_base + 1; + if (PL_curstackinfo->si_type == PERLSI_SORT) { + if (cxstack_ix == PL_sortcxix || dopoptosub(cxstack_ix) <= PL_sortcxix) { + if (cxstack_ix > PL_sortcxix) + dounwind(PL_sortcxix); + AvARRAY(PL_curstack)[1] = *SP; + PL_stack_sp = PL_stack_base + 1; return 0; } } @@ -1462,7 +1528,7 @@ PP(pp_return) { /* Unassume the success we assumed earlier. */ char *name = cx->blk_eval.old_name; - (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD); + (void)hv_delete(GvHVn(PL_incgv), name, strlen(name), G_DISCARD); DIE("%s did not return a true value", name); } break; @@ -1472,11 +1538,23 @@ PP(pp_return) TAINT_NOT; if (gimme == G_SCALAR) { - if (MARK < SP) - *++newsp = (popsub2 && SvTEMP(*SP)) - ? *SP : sv_mortalcopy(*SP); - else - *++newsp = &sv_undef; + if (MARK < SP) { + if (popsub2) { + if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) { + if (SvTEMP(TOPs)) { + *++newsp = SvREFCNT_inc(*SP); + FREETMPS; + sv_2mortal(*newsp); + } else { + FREETMPS; + *++newsp = sv_mortalcopy(*SP); + } + } else + *++newsp = (SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP); + } else + *++newsp = sv_mortalcopy(*SP); + } else + *++newsp = &PL_sv_undef; } else if (gimme == G_ARRAY) { while (++MARK <= SP) { @@ -1485,13 +1563,13 @@ PP(pp_return) TAINT_NOT; /* Each item is independent */ } } - stack_sp = newsp; + PL_stack_sp = newsp; /* Stack values are safe: */ if (popsub2) { POPSUB2(); /* release CV and @_ ... */ } - curpm = newpm; /* ... and pop $1 et al */ + PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; return pop_return(); @@ -1510,9 +1588,9 @@ PP(pp_last) OP *nextop; SV **newsp; PMOP *newpm; - SV **mark = stack_base + cxstack[cxstack_ix].blk_oldsp; + SV **mark = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; - if (op->op_flags & OPf_SPECIAL) { + if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) DIE("Can't \"last\" outside a block"); @@ -1551,7 +1629,7 @@ PP(pp_last) *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP); else - *++newsp = &sv_undef; + *++newsp = &PL_sv_undef; } else if (gimme == G_ARRAY) { while (++MARK <= SP) { @@ -1573,7 +1651,7 @@ PP(pp_last) POPSUB2(); /* release CV and @_ ... */ break; } - curpm = newpm; /* ... and pop $1 et al */ + PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; return nextop; @@ -1585,7 +1663,7 @@ PP(pp_next) register PERL_CONTEXT *cx; I32 oldsave; - if (op->op_flags & OPf_SPECIAL) { + if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) DIE("Can't \"next\" outside a block"); @@ -1599,7 +1677,7 @@ PP(pp_next) dounwind(cxix); TOPBLOCK(cx); - oldsave = scopestack[scopestack_ix - 1]; + oldsave = PL_scopestack[PL_scopestack_ix - 1]; LEAVE_SCOPE(oldsave); return cx->blk_loop.next_op; } @@ -1610,7 +1688,7 @@ PP(pp_redo) register PERL_CONTEXT *cx; I32 oldsave; - if (op->op_flags & OPf_SPECIAL) { + if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) DIE("Can't \"redo\" outside a block"); @@ -1624,14 +1702,12 @@ PP(pp_redo) dounwind(cxix); TOPBLOCK(cx); - oldsave = scopestack[scopestack_ix - 1]; + oldsave = PL_scopestack[PL_scopestack_ix - 1]; LEAVE_SCOPE(oldsave); return cx->blk_loop.redo_op; } -static OP* lastgotoprobe; - -static OP * +STATIC OP * dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit) { OP *kid; @@ -1651,6 +1727,7 @@ dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit) } *ops = 0; if (o->op_flags & OPf_KIDS) { + dTHR; /* First try all the kids at this level, since that's likeliest. */ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) && @@ -1658,7 +1735,7 @@ dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit) return kid; } for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { - if (kid == lastgotoprobe) + if (kid == PL_lastgotoprobe) continue; if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) && (ops == opstack || @@ -1688,10 +1765,10 @@ PP(pp_goto) #define GOTO_DEPTH 64 OP *enterops[GOTO_DEPTH]; char *label; - int do_dump = (op->op_type == OP_DUMP); + int do_dump = (PL_op->op_type == OP_DUMP); label = 0; - if (op->op_flags & OPf_STACKED) { + if (PL_op->op_flags & OPf_STACKED) { SV *sv = POPs; /* This egregious kludge implements goto &subroutine */ @@ -1721,27 +1798,41 @@ PP(pp_goto) TOPBLOCK(cx); if (cx->cx_type == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) DIE("Can't goto subroutine from an eval-string"); - mark = stack_sp; + mark = PL_stack_sp; if (cx->cx_type == CXt_SUB && cx->blk_sub.hasargs) { /* put @_ back onto stack */ AV* av = cx->blk_sub.argarray; items = AvFILLp(av) + 1; - stack_sp++; - EXTEND(stack_sp, items); /* @_ could have been extended. */ - Copy(AvARRAY(av), stack_sp, items, SV*); - stack_sp += items; + PL_stack_sp++; + EXTEND(PL_stack_sp, items); /* @_ could have been extended. */ + Copy(AvARRAY(av), PL_stack_sp, items, SV*); + PL_stack_sp += items; #ifndef USE_THREADS - SvREFCNT_dec(GvAV(defgv)); - GvAV(defgv) = cx->blk_sub.savearray; + SvREFCNT_dec(GvAV(PL_defgv)); + GvAV(PL_defgv) = cx->blk_sub.savearray; #endif /* USE_THREADS */ AvREAL_off(av); av_clear(av); } + else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */ + AV* av; + int i; +#ifdef USE_THREADS + av = (AV*)PL_curpad[0]; +#else + av = GvAV(PL_defgv); +#endif + items = AvFILLp(av) + 1; + PL_stack_sp++; + EXTEND(PL_stack_sp, items); /* @_ could have been extended. */ + Copy(AvARRAY(av), PL_stack_sp, items, SV*); + PL_stack_sp += items; + } if (cx->cx_type == CXt_SUB && !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) SvREFCNT_dec(cx->blk_sub.cv); - oldsave = scopestack[scopestack_ix - 1]; + oldsave = PL_scopestack[PL_scopestack_ix - 1]; LEAVE_SCOPE(oldsave); /* Now do some callish stuff. */ @@ -1755,13 +1846,21 @@ PP(pp_goto) } fp3 = (I32(*)_((int,int,int)))CvXSUB(cv); items = (*fp3)(CvXSUBANY(cv).any_i32, - mark - stack_base + 1, + mark - PL_stack_base + 1, items); - SP = stack_base + items; + SP = PL_stack_base + items; } else { - stack_sp--; /* There is no cv arg. */ - (void)(*CvXSUB(cv))(cv); + SV **newsp; + I32 gimme; + + PL_stack_sp--; /* There is no cv arg. */ + /* Push a mark for the start of arglist */ + PUSHMARK(mark); + (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS); + /* Pop the current context like a decent sub should */ + POPBLOCK(cx, PL_curpm); + /* Do _not_ use PUTBACK, keep the XSUB's return stack! */ } LEAVE; return pop_return(); @@ -1770,8 +1869,8 @@ PP(pp_goto) AV* padlist = CvPADLIST(cv); SV** svp = AvARRAY(padlist); if (cx->cx_type == CXt_EVAL) { - in_eval = cx->blk_eval.old_in_eval; - eval_root = cx->blk_eval.old_eval_root; + PL_in_eval = cx->blk_eval.old_in_eval; + PL_eval_root = cx->blk_eval.old_eval_root; cx->cx_type = CXt_SUB; cx->blk_sub.hasargs = 0; } @@ -1781,7 +1880,7 @@ PP(pp_goto) if (CvDEPTH(cv) < 2) (void)SvREFCNT_inc(cv); else { /* save temporaries on recursion? */ - if (CvDEPTH(cv) == 100 && dowarn) + if (CvDEPTH(cv) == 100 && PL_dowarn) sub_crush_depth(cv); if (CvDEPTH(cv) > AvFILLp(padlist)) { AV *newpad = newAV(); @@ -1789,7 +1888,7 @@ PP(pp_goto) I32 ix = AvFILLp((AV*)svp[1]); svp = AvARRAY(svp[0]); for ( ;ix > 0; ix--) { - if (svp[ix] != &sv_undef) { + if (svp[ix] != &PL_sv_undef) { char *name = SvPVX(svp[ix]); if ((SvFLAGS(svp[ix]) & SVf_FAKE) || *name == '&') @@ -1826,7 +1925,7 @@ PP(pp_goto) } #ifdef USE_THREADS if (!cx->blk_sub.hasargs) { - AV* av = (AV*)curpad[0]; + AV* av = (AV*)PL_curpad[0]; items = AvFILLp(av) + 1; if (items) { @@ -1838,18 +1937,18 @@ PP(pp_goto) } } #endif /* USE_THREADS */ - SAVESPTR(curpad); - curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); + SAVESPTR(PL_curpad); + PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); #ifndef USE_THREADS if (cx->blk_sub.hasargs) #endif /* USE_THREADS */ { - AV* av = (AV*)curpad[0]; + AV* av = (AV*)PL_curpad[0]; SV** ary; #ifndef USE_THREADS - cx->blk_sub.savearray = GvAV(defgv); - GvAV(defgv) = (AV*)SvREFCNT_inc(av); + cx->blk_sub.savearray = GvAV(PL_defgv); + GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); #endif /* USE_THREADS */ cx->blk_sub.argarray = av; ++mark; @@ -1881,7 +1980,7 @@ PP(pp_goto) * We do not care about using sv to call CV; * it's for informational purposes only. */ - SV *sv = GvSV(DBsub); + SV *sv = GvSV(PL_DBsub); CV *gotocv; if (PERLDB_SUB_NN) { @@ -1892,18 +1991,18 @@ PP(pp_goto) } if ( PERLDB_GOTO && (gotocv = perl_get_cv("DB::goto", FALSE)) ) { - PUSHMARK( stack_sp ); + PUSHMARK( PL_stack_sp ); perl_call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG); - stack_sp--; + PL_stack_sp--; } } RETURNOP(CvSTART(cv)); } } else - label = SvPV(sv,na); + label = SvPV(sv,PL_na); } - else if (op->op_flags & OPf_SPECIAL) { + else if (PL_op->op_flags & OPf_SPECIAL) { if (! do_dump) DIE("goto must have label"); } @@ -1915,13 +2014,13 @@ PP(pp_goto) /* find label */ - lastgotoprobe = 0; + PL_lastgotoprobe = 0; *enterops = 0; for (ix = cxstack_ix; ix >= 0; ix--) { cx = &cxstack[ix]; switch (cx->cx_type) { case CXt_EVAL: - gotoprobe = eval_root; /* XXX not good for nested eval */ + gotoprobe = PL_eval_root; /* XXX not good for nested eval */ break; case CXt_LOOP: gotoprobe = cx->blk_oldcop->op_sibling; @@ -1932,7 +2031,7 @@ PP(pp_goto) if (ix) gotoprobe = cx->blk_oldcop->op_sibling; else - gotoprobe = main_root; + gotoprobe = PL_main_root; break; case CXt_SUB: if (CvDEPTH(cx->blk_sub.cv)) { @@ -1945,14 +2044,14 @@ PP(pp_goto) default: if (ix) DIE("panic: goto"); - gotoprobe = main_root; + gotoprobe = PL_main_root; break; } retop = dofindlabel(gotoprobe, label, enterops, enterops + GOTO_DEPTH); if (retop) break; - lastgotoprobe = gotoprobe; + PL_lastgotoprobe = gotoprobe; } if (!retop) DIE("Can't find label %s", label); @@ -1966,42 +2065,42 @@ PP(pp_goto) ix = 0; dounwind(ix); TOPBLOCK(cx); - oldsave = scopestack[scopestack_ix]; + oldsave = PL_scopestack[PL_scopestack_ix]; LEAVE_SCOPE(oldsave); } /* push wanted frames */ if (*enterops && enterops[1]) { - OP *oldop = op; + OP *oldop = PL_op; for (ix = 1; enterops[ix]; ix++) { - op = enterops[ix]; + PL_op = enterops[ix]; /* Eventually we may want to stack the needed arguments * for each op. For now, we punt on the hard ones. */ - if (op->op_type == OP_ENTERITER) + if (PL_op->op_type == OP_ENTERITER) DIE("Can't \"goto\" into the middle of a foreach loop", label); - (*op->op_ppaddr)(ARGS); + (CALLOP->op_ppaddr)(ARGS); } - op = oldop; + PL_op = oldop; } } if (do_dump) { #ifdef VMS - if (!retop) retop = main_start; + if (!retop) retop = PL_main_start; #endif - restartop = retop; - do_undump = TRUE; + PL_restartop = retop; + PL_do_undump = TRUE; my_unexec(); - restartop = 0; /* hmm, must be GNU unexec().. */ - do_undump = FALSE; + PL_restartop = 0; /* hmm, must be GNU unexec().. */ + PL_do_undump = FALSE; } - if (top_env->je_prev) { - restartop = retop; + if (PL_top_env->je_prev) { + PL_restartop = retop; JMPENV_JUMP(3); } @@ -2023,7 +2122,7 @@ PP(pp_exit) #endif } my_exit(anum); - PUSHs(&sv_undef); + PUSHs(&PL_sv_undef); RETURN; } @@ -2043,8 +2142,8 @@ PP(pp_nswitch) match = 0; else if (match > cCOP->uop.scop.scop_max) match = cCOP->uop.scop.scop_max; - op = cCOP->uop.scop.scop_next[match]; - RETURNOP(op); + PL_op = cCOP->uop.scop.scop_next[match]; + RETURNOP(PL_op); } PP(pp_cswitch) @@ -2052,24 +2151,24 @@ PP(pp_cswitch) djSP; register I32 match; - if (multiline) - op = op->op_next; /* can't assume anything */ + if (PL_multiline) + PL_op = PL_op->op_next; /* can't assume anything */ else { - match = *(SvPVx(GvSV(cCOP->cop_gv), na)) & 255; + match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255; match -= cCOP->uop.scop.scop_offset; if (match < 0) match = 0; else if (match > cCOP->uop.scop.scop_max) match = cCOP->uop.scop.scop_max; - op = cCOP->uop.scop.scop_next[match]; + PL_op = cCOP->uop.scop.scop_next[match]; } - RETURNOP(op); + RETURNOP(PL_op); } #endif /* Eval. */ -static void +STATIC void save_lines(AV *array, SV *sv) { register char *s = SvPVX(sv); @@ -2093,40 +2192,40 @@ save_lines(AV *array, SV *sv) } } -static OP * +STATIC OP * docatch(OP *o) { dTHR; int ret; - OP *oldop = op; + OP *oldop = PL_op; dJMPENV; - op = o; + PL_op = o; #ifdef DEBUGGING assert(CATCH_GET == TRUE); - DEBUG_l(deb("Setting up local jumplevel %p, was %p\n", &cur_env, top_env)); + DEBUG_l(deb("Setting up local jumplevel %p, was %p\n", &cur_env, PL_top_env)); #endif JMPENV_PUSH(ret); switch (ret) { default: /* topmost level handles it */ JMPENV_POP; - op = oldop; + PL_op = oldop; JMPENV_JUMP(ret); /* NOTREACHED */ case 3: - if (!restartop) { + if (!PL_restartop) { PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); break; } - op = restartop; - restartop = 0; + PL_op = PL_restartop; + PL_restartop = 0; /* FALL THROUGH */ case 0: - runops(); + CALLRUNOPS(); break; } JMPENV_POP; - op = oldop; + PL_op = oldop; return Nullop; } @@ -2142,7 +2241,7 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) I32 gimme = 0; /* SUSPECT - INITIALZE TO WHAT? NI-S */ I32 optype; OP dummy; - OP *oop = op, *rop; + OP *oop = PL_op, *rop; char tmpbuf[TYPE_DIGITS(long) + 12 + 10]; char *safestr; @@ -2151,73 +2250,77 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) SAVETMPS; /* switch to eval mode */ - SAVESPTR(compiling.cop_filegv); - SAVEI16(compiling.cop_line); - sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++evalseq); - compiling.cop_filegv = gv_fetchfile(tmpbuf+2); - compiling.cop_line = 1; + if (PL_curcop == &PL_compiling) { + SAVESPTR(PL_compiling.cop_stash); + PL_compiling.cop_stash = PL_curstash; + } + SAVESPTR(PL_compiling.cop_filegv); + SAVEI16(PL_compiling.cop_line); + sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); + PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2); + PL_compiling.cop_line = 1; /* XXX For Cs within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs (i.e. before run-time proper). To work around the coredump that ensues, we always turn GvMULTI_on for any globals that were introduced within evals. See force_ident(). GSAR 96-10-12 */ safestr = savepv(tmpbuf); - SAVEDELETE(defstash, safestr, strlen(safestr)); - SAVEI32(hints); + SAVEDELETE(PL_defstash, safestr, strlen(safestr)); + SAVEHINTS(); #ifdef OP_IN_REGISTER - opsave = op; + PL_opsave = op; #else - SAVEPPTR(op); + SAVEPPTR(PL_op); #endif - hints = 0; + PL_hints = 0; - op = &dummy; - op->op_type = 0; /* Avoid uninit warning. */ - op->op_flags = 0; /* Avoid uninit warning. */ + PL_op = &dummy; + PL_op->op_type = 0; /* Avoid uninit warning. */ + PL_op->op_flags = 0; /* Avoid uninit warning. */ PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, 0, compiling.cop_filegv); + PUSHEVAL(cx, 0, PL_compiling.cop_filegv); rop = doeval(G_SCALAR, startop); - POPBLOCK(cx,curpm); + POPBLOCK(cx,PL_curpm); POPEVAL(cx); (*startop)->op_type = OP_NULL; (*startop)->op_ppaddr = ppaddr[OP_NULL]; lex_end(); - *avp = (AV*)SvREFCNT_inc(comppad); + *avp = (AV*)SvREFCNT_inc(PL_comppad); LEAVE; #ifdef OP_IN_REGISTER - op = opsave; + op = PL_opsave; #endif return rop; } /* With USE_THREADS, eval_owner must be held on entry to doeval */ -static OP * +STATIC OP * doeval(int gimme, OP** startop) { dSP; - OP *saveop = op; + OP *saveop = PL_op; HV *newstash; CV *caller; AV* comppadlist; I32 i; - in_eval = 1; + PL_in_eval = 1; PUSHMARK(SP); /* set up a scratch pad */ - SAVEI32(padix); - SAVESPTR(curpad); - SAVESPTR(comppad); - SAVESPTR(comppad_name); - SAVEI32(comppad_name_fill); - SAVEI32(min_intro_pending); - SAVEI32(max_intro_pending); + SAVEI32(PL_padix); + SAVESPTR(PL_curpad); + SAVESPTR(PL_comppad); + SAVESPTR(PL_comppad_name); + SAVEI32(PL_comppad_name_fill); + SAVEI32(PL_min_intro_pending); + SAVEI32(PL_max_intro_pending); - caller = compcv; - for (i = cxstack_ix - 1; i >= 0; i--) { + caller = PL_compcv; + for (i = cxstack_ix; i >= 0; i--) { PERL_CONTEXT *cx = &cxstack[i]; if (cx->cx_type == CXt_EVAL) break; @@ -2227,117 +2330,117 @@ doeval(int gimme, OP** startop) } } - SAVESPTR(compcv); - compcv = (CV*)NEWSV(1104,0); - sv_upgrade((SV *)compcv, SVt_PVCV); - CvUNIQUE_on(compcv); + SAVESPTR(PL_compcv); + PL_compcv = (CV*)NEWSV(1104,0); + sv_upgrade((SV *)PL_compcv, SVt_PVCV); + CvUNIQUE_on(PL_compcv); #ifdef USE_THREADS - CvOWNER(compcv) = 0; - New(666, CvMUTEXP(compcv), 1, perl_mutex); - MUTEX_INIT(CvMUTEXP(compcv)); + CvOWNER(PL_compcv) = 0; + New(666, CvMUTEXP(PL_compcv), 1, perl_mutex); + MUTEX_INIT(CvMUTEXP(PL_compcv)); #endif /* USE_THREADS */ - comppad = newAV(); - av_push(comppad, Nullsv); - curpad = AvARRAY(comppad); - comppad_name = newAV(); - comppad_name_fill = 0; - min_intro_pending = 0; - padix = 0; + PL_comppad = newAV(); + av_push(PL_comppad, Nullsv); + PL_curpad = AvARRAY(PL_comppad); + PL_comppad_name = newAV(); + PL_comppad_name_fill = 0; + PL_min_intro_pending = 0; + PL_padix = 0; #ifdef USE_THREADS - av_store(comppad_name, 0, newSVpv("@_", 2)); - curpad[0] = (SV*)newAV(); - SvPADMY_on(curpad[0]); /* XXX Needed? */ + av_store(PL_comppad_name, 0, newSVpv("@_", 2)); + PL_curpad[0] = (SV*)newAV(); + SvPADMY_on(PL_curpad[0]); /* XXX Needed? */ #endif /* USE_THREADS */ comppadlist = newAV(); AvREAL_off(comppadlist); - av_store(comppadlist, 0, (SV*)comppad_name); - av_store(comppadlist, 1, (SV*)comppad); - CvPADLIST(compcv) = comppadlist; + av_store(comppadlist, 0, (SV*)PL_comppad_name); + av_store(comppadlist, 1, (SV*)PL_comppad); + CvPADLIST(PL_compcv) = comppadlist; if (!saveop || saveop->op_type != OP_REQUIRE) - CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller); + CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller); - SAVEFREESV(compcv); + SAVEFREESV(PL_compcv); /* make sure we compile in the right package */ - newstash = curcop->cop_stash; - if (curstash != newstash) { - SAVESPTR(curstash); - curstash = newstash; + newstash = PL_curcop->cop_stash; + if (PL_curstash != newstash) { + SAVESPTR(PL_curstash); + PL_curstash = newstash; } - SAVESPTR(beginav); - beginav = newAV(); - SAVEFREESV(beginav); + SAVESPTR(PL_beginav); + PL_beginav = newAV(); + SAVEFREESV(PL_beginav); /* try to compile it */ - eval_root = Nullop; - error_count = 0; - curcop = &compiling; - curcop->cop_arybase = 0; - SvREFCNT_dec(rs); - rs = newSVpv("\n", 1); + PL_eval_root = Nullop; + PL_error_count = 0; + PL_curcop = &PL_compiling; + PL_curcop->cop_arybase = 0; + SvREFCNT_dec(PL_rs); + PL_rs = newSVpv("\n", 1); if (saveop && saveop->op_flags & OPf_SPECIAL) - in_eval |= 4; + PL_in_eval |= 4; else sv_setpv(ERRSV,""); - if (yyparse() || error_count || !eval_root) { + if (yyparse() || PL_error_count || !PL_eval_root) { SV **newsp; I32 gimme; PERL_CONTEXT *cx; I32 optype = 0; /* Might be reset by POPEVAL. */ - op = saveop; - if (eval_root) { - op_free(eval_root); - eval_root = Nullop; + PL_op = saveop; + if (PL_eval_root) { + op_free(PL_eval_root); + PL_eval_root = Nullop; } - SP = stack_base + POPMARK; /* pop original mark */ + SP = PL_stack_base + POPMARK; /* pop original mark */ if (!startop) { - POPBLOCK(cx,curpm); + POPBLOCK(cx,PL_curpm); POPEVAL(cx); pop_return(); } lex_end(); LEAVE; if (optype == OP_REQUIRE) { - char* msg = SvPVx(ERRSV, na); + char* msg = SvPVx(ERRSV, PL_na); DIE("%s", *msg ? msg : "Compilation failed in require"); } else if (startop) { - char* msg = SvPVx(ERRSV, na); + char* msg = SvPVx(ERRSV, PL_na); - POPBLOCK(cx,curpm); + POPBLOCK(cx,PL_curpm); POPEVAL(cx); croak("%sCompilation failed in regexp", (*msg ? msg : "Unknown error\n")); } - SvREFCNT_dec(rs); - rs = SvREFCNT_inc(nrs); + SvREFCNT_dec(PL_rs); + PL_rs = SvREFCNT_inc(PL_nrs); #ifdef USE_THREADS - MUTEX_LOCK(&eval_mutex); - eval_owner = 0; - COND_SIGNAL(&eval_cond); - MUTEX_UNLOCK(&eval_mutex); + MUTEX_LOCK(&PL_eval_mutex); + PL_eval_owner = 0; + COND_SIGNAL(&PL_eval_cond); + MUTEX_UNLOCK(&PL_eval_mutex); #endif /* USE_THREADS */ RETPUSHUNDEF; } - SvREFCNT_dec(rs); - rs = SvREFCNT_inc(nrs); - compiling.cop_line = 0; + SvREFCNT_dec(PL_rs); + PL_rs = SvREFCNT_inc(PL_nrs); + PL_compiling.cop_line = 0; if (startop) { - *startop = eval_root; - SvREFCNT_dec(CvOUTSIDE(compcv)); - CvOUTSIDE(compcv) = Nullcv; + *startop = PL_eval_root; + SvREFCNT_dec(CvOUTSIDE(PL_compcv)); + CvOUTSIDE(PL_compcv) = Nullcv; } else - SAVEFREEOP(eval_root); + SAVEFREEOP(PL_eval_root); if (gimme & G_VOID) - scalarvoid(eval_root); + scalarvoid(PL_eval_root); else if (gimme & G_ARRAY) - list(eval_root); + list(PL_eval_root); else - scalar(eval_root); + scalar(PL_eval_root); DEBUG_x(dump_eval()); @@ -2347,7 +2450,7 @@ doeval(int gimme, OP** startop) if (cv) { dSP; PUSHMARK(SP); - XPUSHs((SV*)compiling.cop_filegv); + XPUSHs((SV*)PL_compiling.cop_filegv); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); } @@ -2355,17 +2458,17 @@ doeval(int gimme, OP** startop) /* compiled okay, so do it */ - CvDEPTH(compcv) = 1; - SP = stack_base + POPMARK; /* pop original mark */ - op = saveop; /* The caller may need it. */ + CvDEPTH(PL_compcv) = 1; + SP = PL_stack_base + POPMARK; /* pop original mark */ + PL_op = saveop; /* The caller may need it. */ #ifdef USE_THREADS - MUTEX_LOCK(&eval_mutex); - eval_owner = 0; - COND_SIGNAL(&eval_cond); - MUTEX_UNLOCK(&eval_mutex); + MUTEX_LOCK(&PL_eval_mutex); + PL_eval_owner = 0; + COND_SIGNAL(&PL_eval_cond); + MUTEX_UNLOCK(&PL_eval_mutex); #endif /* USE_THREADS */ - RETURNOP(eval_start); + RETURNOP(PL_eval_start); } PP(pp_require) @@ -2384,18 +2487,18 @@ PP(pp_require) sv = POPs; if (SvNIOKp(sv) && !SvPOKp(sv)) { SET_NUMERIC_STANDARD(); - if (atof(patchlevel) + 0.00000999 < SvNV(sv)) + if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv)) DIE("Perl %s required--this is only version %s, stopped", - SvPV(sv,na),patchlevel); + SvPV(sv,PL_na),PL_patchlevel); RETPUSHYES; } name = SvPV(sv, len); if (!(name && len > 0 && *name)) DIE("Null filename used"); TAINT_PROPER("require"); - if (op->op_type == OP_REQUIRE && - (svp = hv_fetch(GvHVn(incgv), name, len, 0)) && - *svp != &sv_undef) + if (PL_op->op_type == OP_REQUIRE && + (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0)) && + *svp != &PL_sv_undef) RETPUSHYES; /* prepare to compile file */ @@ -2420,7 +2523,7 @@ PP(pp_require) tryrsfp = PerlIO_open(name,PERL_SCRIPT_MODE); } else { - AV *ar = GvAVn(incgv); + AV *ar = GvAVn(PL_incgv); I32 i; #ifdef VMS char *unixname; @@ -2429,7 +2532,7 @@ PP(pp_require) { namesv = NEWSV(806, 0); for (i = 0; i <= AvFILL(ar); i++) { - char *dir = SvPVx(*av_fetch(ar, i, TRUE), na); + char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na); #ifdef VMS char *unixdir; if ((unixdir = tounixpath(dir, Nullch)) == Nullch) @@ -2449,14 +2552,14 @@ PP(pp_require) } } } - SAVESPTR(compiling.cop_filegv); - compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name); + SAVESPTR(PL_compiling.cop_filegv); + PL_compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name); SvREFCNT_dec(namesv); if (!tryrsfp) { - if (op->op_type == OP_REQUIRE) { + if (PL_op->op_type == OP_REQUIRE) { SV *msg = sv_2mortal(newSVpvf("Can't locate %s in @INC", name)); SV *dirmsgsv = NEWSV(0, 0); - AV *ar = GvAVn(incgv); + AV *ar = GvAVn(PL_incgv); I32 i; if (instr(SvPVX(msg), ".h ")) sv_catpv(msg, " (change .h to .ph maybe?)"); @@ -2464,7 +2567,7 @@ PP(pp_require) sv_catpv(msg, " (did you run h2ph?)"); sv_catpv(msg, " (@INC contains:"); for (i = 0; i <= AvFILL(ar); i++) { - char *dir = SvPVx(*av_fetch(ar, i, TRUE), na); + char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na); sv_setpvf(dirmsgsv, " %s", dir); sv_catsv(msg, dirmsgsv); } @@ -2477,39 +2580,39 @@ PP(pp_require) } /* Assume success here to prevent recursive requirement. */ - (void)hv_store(GvHVn(incgv), name, strlen(name), - newSVsv(GvSV(compiling.cop_filegv)), 0 ); + (void)hv_store(GvHVn(PL_incgv), name, strlen(name), + newSVsv(GvSV(PL_compiling.cop_filegv)), 0 ); ENTER; SAVETMPS; lex_start(sv_2mortal(newSVpv("",0))); - if (rsfp_filters){ - save_aptr(&rsfp_filters); - rsfp_filters = NULL; + if (PL_rsfp_filters){ + save_aptr(&PL_rsfp_filters); + PL_rsfp_filters = NULL; } - rsfp = tryrsfp; + PL_rsfp = tryrsfp; name = savepv(name); SAVEFREEPV(name); - SAVEI32(hints); - hints = 0; + SAVEHINTS(); + PL_hints = 0; /* switch to eval mode */ - push_return(op->op_next); + push_return(PL_op->op_next); PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, name, compiling.cop_filegv); + PUSHEVAL(cx, name, PL_compiling.cop_filegv); - compiling.cop_line = 0; + PL_compiling.cop_line = 0; PUTBACK; #ifdef USE_THREADS - MUTEX_LOCK(&eval_mutex); - if (eval_owner && eval_owner != thr) - while (eval_owner) - COND_WAIT(&eval_cond, &eval_mutex); - eval_owner = thr; - MUTEX_UNLOCK(&eval_mutex); + 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 */ return DOCATCH(doeval(G_SCALAR, NULL)); } @@ -2524,7 +2627,7 @@ PP(pp_entereval) djSP; register PERL_CONTEXT *cx; dPOPss; - I32 gimme = GIMME_V, was = sub_generation; + I32 gimme = GIMME_V, was = PL_sub_generation; char tmpbuf[TYPE_DIGITS(long) + 12]; char *safestr; STRLEN len; @@ -2540,40 +2643,40 @@ PP(pp_entereval) /* switch to eval mode */ - SAVESPTR(compiling.cop_filegv); - sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++evalseq); - compiling.cop_filegv = gv_fetchfile(tmpbuf+2); - compiling.cop_line = 1; + SAVESPTR(PL_compiling.cop_filegv); + sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq); + PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2); + PL_compiling.cop_line = 1; /* XXX For Cs within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs (i.e. before run-time proper). To work around the coredump that ensues, we always turn GvMULTI_on for any globals that were introduced within evals. See force_ident(). GSAR 96-10-12 */ safestr = savepv(tmpbuf); - SAVEDELETE(defstash, safestr, strlen(safestr)); - SAVEI32(hints); - hints = op->op_targ; + SAVEDELETE(PL_defstash, safestr, strlen(safestr)); + SAVEHINTS(); + PL_hints = PL_op->op_targ; - push_return(op->op_next); + push_return(PL_op->op_next); PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, 0, compiling.cop_filegv); + PUSHEVAL(cx, 0, PL_compiling.cop_filegv); /* prepare to compile string */ - if (PERLDB_LINE && curstash != debstash) - save_lines(GvAV(compiling.cop_filegv), linestr); + if (PERLDB_LINE && PL_curstash != PL_debstash) + save_lines(GvAV(PL_compiling.cop_filegv), PL_linestr); PUTBACK; #ifdef USE_THREADS - MUTEX_LOCK(&eval_mutex); - if (eval_owner && eval_owner != thr) - while (eval_owner) - COND_WAIT(&eval_cond, &eval_mutex); - eval_owner = thr; - MUTEX_UNLOCK(&eval_mutex); + 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 */ ret = doeval(gimme, NULL); - if (PERLDB_INTER && was != sub_generation /* Some subs defined here. */ - && ret != op->op_next) { /* Successive compilation. */ + if (PERLDB_INTER && was != PL_sub_generation /* Some subs defined here. */ + && ret != PL_op->op_next) { /* Successive compilation. */ strcpy(safestr, "_<(eval )"); /* Anything fake and short. */ } return DOCATCH(ret); @@ -2588,7 +2691,7 @@ PP(pp_leaveeval) I32 gimme; register PERL_CONTEXT *cx; OP *retop; - U8 save_flags = op -> op_flags; + U8 save_flags = PL_op -> op_flags; I32 optype; POPBLOCK(cx,newpm); @@ -2608,7 +2711,7 @@ PP(pp_leaveeval) } else { MEXTEND(mark,0); - *MARK = &sv_undef; + *MARK = &PL_sv_undef; } } else { @@ -2620,7 +2723,7 @@ PP(pp_leaveeval) } } } - curpm = newpm; /* Don't pop $1 et al till now */ + PL_curpm = newpm; /* Don't pop $1 et al till now */ /* * Closures mentioned at top level of eval cannot be referenced @@ -2628,16 +2731,16 @@ PP(pp_leaveeval) * (Note that the fact that compcv and friends are still set here * is, AFAIK, an accident.) --Chip */ - if (AvFILLp(comppad_name) >= 0) { - SV **svp = AvARRAY(comppad_name); + if (AvFILLp(PL_comppad_name) >= 0) { + SV **svp = AvARRAY(PL_comppad_name); I32 ix; - for (ix = AvFILLp(comppad_name); ix >= 0; ix--) { + for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) { SV *sv = svp[ix]; - if (sv && sv != &sv_undef && *SvPVX(sv) == '&') { + if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') { SvREFCNT_dec(sv); - svp[ix] = &sv_undef; + svp[ix] = &PL_sv_undef; - sv = curpad[ix]; + sv = PL_curpad[ix]; if (CvCLONE(sv)) { SvREFCNT_dec(CvOUTSIDE(sv)); CvOUTSIDE(sv) = Nullcv; @@ -2646,16 +2749,16 @@ PP(pp_leaveeval) SvREFCNT_dec(sv); sv = NEWSV(0,0); SvPADTMP_on(sv); - curpad[ix] = sv; + PL_curpad[ix] = sv; } } } } #ifdef DEBUGGING - assert(CvDEPTH(compcv) == 1); + assert(CvDEPTH(PL_compcv) == 1); #endif - CvDEPTH(compcv) = 0; + CvDEPTH(PL_compcv) = 0; lex_end(); if (optype == OP_REQUIRE && @@ -2663,7 +2766,7 @@ PP(pp_leaveeval) { /* Unassume the success we assumed earlier. */ char *name = cx->blk_eval.old_name; - (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD); + (void)hv_delete(GvHVn(PL_incgv), name, strlen(name), G_DISCARD); retop = die("%s did not return a true value", name); /* die_where() did LEAVE, or we won't be here */ } @@ -2688,12 +2791,12 @@ PP(pp_entertry) push_return(cLOGOP->op_other->op_next); PUSHBLOCK(cx, CXt_EVAL, SP); PUSHEVAL(cx, 0, 0); - eval_root = op; /* Only needed so that goto works right. */ + PL_eval_root = PL_op; /* Only needed so that goto works right. */ - in_eval = 1; + PL_in_eval = 1; sv_setpv(ERRSV,""); PUTBACK; - return DOCATCH(op->op_next); + return DOCATCH(PL_op->op_next); } PP(pp_leavetry) @@ -2723,7 +2826,7 @@ PP(pp_leavetry) } else { MEXTEND(mark,0); - *MARK = &sv_undef; + *MARK = &PL_sv_undef; } SP = MARK; } @@ -2736,14 +2839,14 @@ PP(pp_leavetry) } } } - curpm = newpm; /* Don't pop $1 et al till now */ + PL_curpm = newpm; /* Don't pop $1 et al till now */ LEAVE; sv_setpv(ERRSV,""); RETURN; } -static void +STATIC void doparseform(SV *sv) { STRLEN len; @@ -3027,8 +3130,13 @@ struct partition_stack_entry { /* Return < 0 == 0 or > 0 as the value of elt1 is < elt2, == elt2, > elt2 */ +#ifdef PERL_OBJECT +#define qsort_cmp(elt1, elt2) \ + ((this->*compare)(array[elt1], array[elt2])) +#else #define qsort_cmp(elt1, elt2) \ ((*compare)(array[elt1], array[elt2])) +#endif #ifdef QSORT_ORDER_GUESS #define QSORT_NOTICE_SWAP swapped++; @@ -3108,11 +3216,15 @@ doqsort_all_asserts( /* ****************************************************************** qsort */ -void +STATIC void +#ifdef PERL_OBJECT +qsortsv(SV ** array, size_t num_elts, SVCOMPARE compare) +#else qsortsv( SV ** array, size_t num_elts, I32 (*compare)(SV *a, SV *b)) +#endif { register SV * temp;