tmpstr = POPs;
/* prevent recompiling under /o and ithreads. */
-#if defined(USE_ITHREADS) || defined(USE_5005THREADS)
+#if defined(USE_ITHREADS)
if (pm->op_pmflags & PMf_KEEP && PM_GETRE(pm))
RETURN;
#endif
/* 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_5005THREADS)
+#if !defined(USE_ITHREADS)
/* XXX can't change the optree at runtime either */
cLOGOP->op_first->op_next = PL_op->op_next;
#endif
}
/* copy the new items down to the destination list */
dst = PL_stack_base + (PL_markstack_ptr[-2] += items) - 1;
- while (items--)
+ while (items-- > 0)
*dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
}
LEAVE; /* exit inner scope */
return NORMAL;
}
+/* like pp_nextstate, but used instead when the debugger is active */
+
PP(pp_dbstate)
{
PL_curcop = (COP*)PL_op;
PUSHSUB(cx);
CvDEPTH(cv)++;
(void)SvREFCNT_inc(cv);
- SAVEVPTR(PL_curpad);
- PL_curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE));
+ PAD_SET_CUR(CvPADLIST(cv),1);
RETURNOP(CvSTART(cv));
}
else
ENTER;
SAVETMPS;
-#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_5005THREADS */
if (PL_op->op_targ) {
#ifndef USE_ITHREADS
- svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */
+ svp = &PAD_SVl(PL_op->op_targ); /* "my" variable */
SAVESPTR(*svp);
#else
SAVEPADSV(PL_op->op_targ);
EXTEND(PL_stack_sp, items); /* @_ could have been extended. */
Copy(AvARRAY(av), PL_stack_sp, items, SV*);
PL_stack_sp += items;
-#ifndef USE_5005THREADS
SvREFCNT_dec(GvAV(PL_defgv));
GvAV(PL_defgv) = cx->blk_sub.savearray;
-#endif /* USE_5005THREADS */
/* abandon @_ if it got reified */
if (AvREAL(av)) {
(void)sv_2mortal((SV*)av); /* delay until return */
av = newAV();
av_extend(av, items-1);
AvFLAGS(av) = AVf_REIFY;
- PL_curpad[0] = (SV*)(cx->blk_sub.argarray = av);
+ PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
}
}
else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
AV* av;
-#ifdef USE_5005THREADS
- 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. */
}
else {
AV* padlist = CvPADLIST(cv);
- SV** svp = AvARRAY(padlist);
if (CxTYPE(cx) == CXt_EVAL) {
PL_in_eval = cx->blk_eval.old_in_eval;
PL_eval_root = cx->blk_eval.old_eval_root;
}
cx->blk_sub.cv = cv;
cx->blk_sub.olddepth = (U16)CvDEPTH(cv);
+
CvDEPTH(cv)++;
if (CvDEPTH(cv) < 2)
(void)SvREFCNT_inc(cv);
- else { /* save temporaries on recursion? */
+ else {
if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
sub_crush_depth(cv);
- if (CvDEPTH(cv) > AvFILLp(padlist)) {
- AV *newpad = newAV();
- SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
- I32 ix = AvFILLp((AV*)svp[1]);
- I32 names_fill = AvFILLp((AV*)svp[0]);
- svp = AvARRAY(svp[0]);
- for ( ;ix > 0; ix--) {
- if (names_fill >= ix && svp[ix] != &PL_sv_undef) {
- char *name = SvPVX(svp[ix]);
- if ((SvFLAGS(svp[ix]) & SVf_FAKE)
- || *name == '&')
- {
- /* outer lexical or anon code */
- av_store(newpad, ix,
- SvREFCNT_inc(oldpad[ix]) );
- }
- else { /* our own lexical */
- if (*name == '@')
- av_store(newpad, ix, sv = (SV*)newAV());
- else if (*name == '%')
- av_store(newpad, ix, sv = (SV*)newHV());
- else
- av_store(newpad, ix, sv = NEWSV(0,0));
- SvPADMY_on(sv);
- }
- }
- else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
- av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
- }
- else {
- av_store(newpad, ix, sv = NEWSV(0,0));
- SvPADTMP_on(sv);
- }
- }
- if (cx->blk_sub.hasargs) {
- AV* av = newAV();
- av_extend(av, 0);
- av_store(newpad, 0, (SV*)av);
- AvFLAGS(av) = AVf_REIFY;
- }
- av_store(padlist, CvDEPTH(cv), (SV*)newpad);
- AvFILLp(padlist) = CvDEPTH(cv);
- svp = AvARRAY(padlist);
- }
+ pad_push(padlist, CvDEPTH(cv), cx->blk_sub.hasargs);
}
-#ifdef USE_5005THREADS
- if (!cx->blk_sub.hasargs) {
- AV* av = (AV*)PL_curpad[0];
-
- items = AvFILLp(av) + 1;
- if (items) {
- /* Mark is at the end of the stack. */
- EXTEND(SP, items);
- Copy(AvARRAY(av), SP + 1, items, SV*);
- SP += items;
- PUTBACK ;
- }
- }
-#endif /* USE_5005THREADS */
- SAVEVPTR(PL_curpad);
- PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
-#ifndef USE_5005THREADS
+ PAD_SET_CUR(padlist, CvDEPTH(cv));
if (cx->blk_sub.hasargs)
-#endif /* USE_5005THREADS */
{
- AV* av = (AV*)PL_curpad[0];
+ AV* av = (AV*)PAD_SVl(0);
SV** ary;
-#ifndef USE_5005THREADS
cx->blk_sub.savearray = GvAV(PL_defgv);
GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-#endif /* USE_5005THREADS */
- cx->blk_sub.oldcurpad = PL_curpad;
+ CX_CURPAD_SAVE(cx->blk_sub);
cx->blk_sub.argarray = av;
++mark;
dSP;
OP *saveop = PL_op;
CV *caller;
- AV* comppadlist;
I32 i;
PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
PUSHMARK(SP);
- /* set up a scratch pad */
-
- SAVEI32(PL_padix);
- SAVEVPTR(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 = PL_compcv;
for (i = cxstack_ix - 1; i >= 0; i--) {
PERL_CONTEXT *cx = &cxstack[i];
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_5005THREADS */
-
- 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_5005THREADS
- av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
- PL_curpad[0] = (SV*)newAV();
- SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
-#endif /* USE_5005THREADS */
-
- comppadlist = newAV();
- AvREAL_off(comppadlist);
- av_store(comppadlist, 0, (SV*)PL_comppad_name);
- av_store(comppadlist, 1, (SV*)PL_comppad);
- CvPADLIST(PL_compcv) = comppadlist;
+ /* set up a scratch pad */
+
+ CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
if (!saveop ||
(saveop->op_type != OP_REQUIRE && saveop->op_type != OP_DOFILE))
Perl_croak(aTHX_ "%sCompilation failed in regexp",
(*msg ? msg : "Unknown error\n"));
}
-#ifdef USE_5005THREADS
- MUTEX_LOCK(&PL_eval_mutex);
- PL_eval_owner = 0;
- COND_SIGNAL(&PL_eval_cond);
- MUTEX_UNLOCK(&PL_eval_mutex);
-#endif /* USE_5005THREADS */
RETPUSHUNDEF;
}
CopLINE_set(&PL_compiling, 0);
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_5005THREADS
- MUTEX_LOCK(&PL_eval_mutex);
- PL_eval_owner = 0;
- COND_SIGNAL(&PL_eval_cond);
- MUTEX_UNLOCK(&PL_eval_mutex);
-#endif /* USE_5005THREADS */
RETURNOP(PL_eval_start);
}
RETPUSHUNDEF;
}
else
- SETERRNO(0, SS$_NORMAL);
+ SETERRNO(0, SS_NORMAL);
/* Assume success here to prevent recursive requirement. */
len = strlen(name);
CopLINE_set(&PL_compiling, 0);
PUTBACK;
-#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_5005THREADS */
/* Store and reset encoding. */
encoding = PL_encoding;
if (PERLDB_LINE && PL_curstash != PL_debstash)
save_lines(CopFILEAV(&PL_compiling), PL_linestr);
PUTBACK;
-#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_5005THREADS */
ret = doeval(gimme, NULL);
if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
&& ret != PL_op->op_next) { /* Successive compilation. */