static OP *docatch _((OP *o));
static OP *doeval _((int gimme));
-static OP *dofindlabel _((OP *op, char *label, OP **opstack, OP **oplimit));
+static OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit));
static void doparseform _((SV *sv));
static I32 dopoptoeval _((I32 startingblock));
static I32 dopoptolabel _((char *label));
pm->op_pmflags |= PMf_WHITE;
if (pm->op_pmflags & PMf_KEEP) {
- pm->op_pmflags &= ~PMf_RUNTIME; /* no point compiling again */
+ pm->op_private &= ~OPpRUNTIME; /* no point compiling again */
hoistmust(pm);
cLOGOP->op_first->op_next = op->op_next;
}
char *orig = cx->sb_orig;
register REGEXP *rx = cx->sb_rx;
+ rxres_restore(&cx->sb_rxres, rx);
+
if (cx->sb_iters++) {
if (cx->sb_iters > cx->sb_maxiters)
DIE("Substitution loop");
sv_catpvn(dstr, s, m-s);
cx->sb_s = rx->endp[0];
cx->sb_rxtainted |= rx->exec_tainted;
+ rxres_save(&cx->sb_rxres, rx);
RETURNOP(pm->op_pmreplstart);
}
+void
+rxres_save(rsp, rx)
+void **rsp;
+REGEXP *rx;
+{
+ UV *p = (UV*)*rsp;
+ U32 i;
+
+ if (!p || p[1] < rx->nparens) {
+ i = 6 + rx->nparens * 2;
+ if (!p)
+ New(501, p, i, UV);
+ else
+ Renew(p, i, UV);
+ *rsp = (void*)p;
+ }
+
+ *p++ = (UV)rx->subbase;
+ rx->subbase = Nullch;
+
+ *p++ = rx->nparens;
+
+ *p++ = (UV)rx->subbeg;
+ *p++ = (UV)rx->subend;
+ for (i = 0; i <= rx->nparens; ++i) {
+ *p++ = (UV)rx->startp[i];
+ *p++ = (UV)rx->endp[i];
+ }
+}
+
+void
+rxres_restore(rsp, rx)
+void **rsp;
+REGEXP *rx;
+{
+ UV *p = (UV*)*rsp;
+ U32 i;
+
+ Safefree(rx->subbase);
+ rx->subbase = (char*)(*p);
+ *p++ = 0;
+
+ rx->nparens = *p++;
+
+ rx->subbeg = (char*)(*p++);
+ rx->subend = (char*)(*p++);
+ for (i = 0; i <= rx->nparens; ++i) {
+ rx->startp[i] = (char*)(*p++);
+ rx->endp[i] = (char*)(*p++);
+ }
+}
+
+void
+rxres_free(rsp)
+void **rsp;
+{
+ UV *p = (UV*)*rsp;
+
+ if (p) {
+ Safefree((char*)(*p));
+ Safefree(p);
+ *rsp = Null(void*);
+ }
+}
+
PP(pp_formline)
{
dSP; dMARK; dORIGMARK;
RETURNOP(op->op_next->op_next);
}
stack_sp = stack_base + *markstack_ptr + 1;
- pp_pushmark(); /* push dst */
- pp_pushmark(); /* push src */
+ pp_pushmark(ARGS); /* push dst */
+ pp_pushmark(ARGS); /* push src */
ENTER; /* enter outer scope */
SAVETMPS;
PUTBACK;
if (op->op_type == OP_MAPSTART)
- pp_pushmark(); /* push top */
+ pp_pushmark(ARGS); /* push top */
return ((LOGOP*)op->op_next)->op_other;
}
sortcop = CvSTART(cv);
SAVESPTR(CvROOT(cv)->op_ppaddr);
CvROOT(cv)->op_ppaddr = ppaddr[OP_NULL];
-
+
SAVESPTR(curpad);
curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
}
bool oldcatch = CATCH_GET;
SAVETMPS;
- SAVESPTR(op);
+ SAVEOP();
oldstack = curstack;
if (!sortstack) {
SAVESPTR(GvSV(firstgv));
SAVESPTR(GvSV(secondgv));
+
PUSHBLOCK(cx, CXt_NULL, stack_base);
+ if (!(op->op_flags & OPf_SPECIAL)) {
+ bool hasargs = FALSE;
+ cx->cx_type = CXt_SUB;
+ cx->blk_gimme = G_SCALAR;
+ PUSHSUB(cx);
+ if (!CvDEPTH(cv))
+ SvREFCNT_inc(cv); /* in preparation for POPSUB */
+ }
sortcxix = cxstack_ix;
qsort((char*)(myorigmark+1), max, sizeof(SV*), sortcv);
dopoptolabel(label)
char *label;
{
+ dTHR;
register I32 i;
register CONTEXT *cx;
I32
block_gimme()
{
+ dTHR;
I32 cxix;
cxix = dopoptosub(cxstack_ix);
dopoptosub(startingblock)
I32 startingblock;
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
dopoptoeval(startingblock)
I32 startingblock;
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
dopoptoloop(startingblock)
I32 startingblock;
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
dounwind(cxix)
I32 cxix;
{
+ dTHR;
register CONTEXT *cx;
SV **newsp;
I32 optype;
while (cxstack_ix > cxix) {
- cx = &cxstack[cxstack_ix--];
- DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n", (long) cxstack_ix+1,
- block_type[cx->cx_type]));
+ cx = &cxstack[cxstack_ix];
+ DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
+ (long) cxstack_ix+1, block_type[cx->cx_type]));
/* Note: we don't need to restore the base context info till the end. */
switch (cx->cx_type) {
+ case CXt_SUBST:
+ POPSUBST(cx);
+ continue; /* not break */
case CXt_SUB:
POPSUB(cx);
break;
POPLOOP(cx);
break;
case CXt_NULL:
- case CXt_SUBST:
break;
}
+ cxstack_ix--;
}
}
die_where(message)
char *message;
{
+ dTHR;
if (in_eval) {
I32 cxix;
register CONTEXT *cx;
mark++;
}
*sp = cv;
- return pp_entersub();
+ return pp_entersub(ARGS);
}
#endif
const void *a;
const void *b;
{
+ dTHR;
SV * const *str1 = (SV * const *)a;
SV * const *str2 = (SV * const *)b;
I32 oldsaveix = savestack_ix;
return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b);
}
+#ifdef USE_THREADS
+static void
+unlock_condpair(svv)
+void *svv;
+{
+ dTHR;
+ MAGIC *mg = mg_find((SV*)svv, 'm');
+
+ if (!mg)
+ croak("panic: unlock_condpair unlocking non-mutex");
+ MUTEX_LOCK(MgMUTEXP(mg));
+ if (MgOWNER(mg) != thr)
+ croak("panic: unlock_condpair unlocking mutex that we don't own");
+ MgOWNER(mg) = 0;
+ COND_SIGNAL(MgOWNERCONDP(mg));
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+}
+#endif /* USE_THREADS */
+
PP(pp_reset)
{
dSP;
+#ifdef USE_THREADS
+ dTOPss;
+ MAGIC *mg;
+
+ if (MAXARG < 1)
+ croak("reset requires mutex argument with USE_THREADS");
+ if (SvROK(sv)) {
+ /*
+ * Kludge to allow lock of real objects without requiring
+ * to pass in every type of argument by explicit reference.
+ */
+ sv = SvRV(sv);
+ }
+ mg = condpair_magic(sv);
+ MUTEX_LOCK(MgMUTEXP(mg));
+ if (MgOWNER(mg) == thr)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ else {
+ while (MgOWNER(mg))
+ COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
+ MgOWNER(mg) = thr;
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ save_destructor(unlock_condpair, sv);
+ }
+ RETURN;
+#else
char *tmps;
if (MAXARG < 1)
sv_reset(tmps, curcop->cop_stash);
PUSHs(&sv_yes);
RETURN;
+#endif /* USE_THREADS */
}
PP(pp_lineseq)
I32 optype = 0;
if (curstack == sortstack) {
- if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) < sortcxix) {
+ if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) <= sortcxix) {
if (cxstack_ix > sortcxix)
dounwind(sortcxix);
AvARRAY(curstack)[1] = *SP;
static OP* lastgotoprobe;
static OP *
-dofindlabel(op,label,opstack,oplimit)
-OP *op;
+dofindlabel(o,label,opstack,oplimit)
+OP *o;
char *label;
OP **opstack;
OP **oplimit;
if (ops >= oplimit)
croak(too_deep);
- if (op->op_type == OP_LEAVE ||
- op->op_type == OP_SCOPE ||
- op->op_type == OP_LEAVELOOP ||
- op->op_type == OP_LEAVETRY)
+ if (o->op_type == OP_LEAVE ||
+ o->op_type == OP_SCOPE ||
+ o->op_type == OP_LEAVELOOP ||
+ o->op_type == OP_LEAVETRY)
{
- *ops++ = cUNOP->op_first;
+ *ops++ = cUNOPo->op_first;
if (ops >= oplimit)
croak(too_deep);
}
*ops = 0;
- if (op->op_flags & OPf_KIDS) {
+ if (o->op_flags & OPf_KIDS) {
/* First try all the kids at this level, since that's likeliest. */
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
kCOP->cop_label && strEQ(kCOP->cop_label, label))
return kid;
}
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if (kid == lastgotoprobe)
continue;
if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
(ops[-1]->op_type != OP_NEXTSTATE &&
ops[-1]->op_type != OP_DBSTATE)))
*ops++ = kid;
- if (op = dofindlabel(kid, label, ops, oplimit))
- return op;
+ if (o = dofindlabel(kid, label, ops, oplimit))
+ return o;
}
}
*ops = 0;
for (ix = cxstack_ix; ix >= 0; ix--) {
cx = &cxstack[ix];
switch (cx->cx_type) {
- case CXt_SUB:
- gotoprobe = CvROOT(cx->blk_sub.cv);
- break;
case CXt_EVAL:
gotoprobe = eval_root; /* XXX not good for nested eval */
break;
else
gotoprobe = main_root;
break;
+ case CXt_SUB:
+ if (CvDEPTH(cx->blk_sub.cv)) {
+ gotoprobe = CvROOT(cx->blk_sub.cv);
+ break;
+ }
+ /* FALL THROUGH */
case CXt_NULL:
DIE("Can't \"goto\" outside a block");
default:
OP *oldop = op;
for (ix = 1; enterops[ix]; ix++) {
op = enterops[ix];
- (*op->op_ppaddr)();
+ (*op->op_ppaddr)(ARGS);
}
op = oldop;
}
docatch(o)
OP *o;
{
+ dTHR;
int ret;
I32 oldrunlevel = runlevel;
OP *oldop = op;
doeval(gimme)
int gimme;
{
+ dTHR;
dSP;
OP *saveop = op;
HV *newstash;
CV *caller;
AV* comppadlist;
+#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);
+#endif /* USE_THREADS */
in_eval = 1;
PUSHMARK(SP);
compcv = (CV*)NEWSV(1104,0);
sv_upgrade((SV *)compcv, SVt_PVCV);
CvUNIQUE_on(compcv);
+#ifdef USE_THREADS
+ CvOWNER(compcv) = 0;
+ New(666, CvMUTEXP(compcv), 1, pthread_mutex_t);
+ MUTEX_INIT(CvMUTEXP(compcv));
+ New(666, CvCONDP(compcv), 1, pthread_cond_t);
+ COND_INIT(CvCONDP(compcv));
+#endif /* USE_THREADS */
comppad = newAV();
comppad_name = newAV();
comppad_name_fill = 0;
+#ifdef USE_THREADS
+ av_store(comppad_name, 0, newSVpv("@_", 2));
+#endif /* USE_THREADS */
min_intro_pending = 0;
av_push(comppad, Nullsv);
curpad = AvARRAY(comppad);
/* compiled okay, so do it */
CvDEPTH(compcv) = 1;
-
SP = stack_base + POPMARK; /* pop original mark */
+#ifdef USE_THREADS
+ MUTEX_LOCK(&eval_mutex);
+ eval_owner = 0;
+ COND_SIGNAL(&eval_cond);
+ MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
+
RETURNOP(eval_start);
}
projects / p5sagit/p5-mst-13.2.git / blobdiff