summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--XSUB.h2
-rw-r--r--av.c7
-rw-r--r--cv.h10
-rw-r--r--deb.c23
-rw-r--r--doio.c10
-rw-r--r--doop.c1
-rw-r--r--dump.c156
-rw-r--r--embed.h16
-rw-r--r--global.sym4
-rw-r--r--gv.c10
-rw-r--r--hv.c2
-rw-r--r--keywords.h492
-rw-r--r--malloc.c8
-rw-r--r--mg.c24
-rw-r--r--op.c1509
-rw-r--r--op.h14
-rwxr-xr-xopcode.pl4
-rw-r--r--perl.c144
-rw-r--r--perl.h31
-rw-r--r--pp.h7
-rw-r--r--pp_ctl.c117
-rw-r--r--pp_hot.c151
-rw-r--r--pp_sys.c12
-rw-r--r--proto.h62
-rw-r--r--regcomp.c20
-rw-r--r--regexec.c3
-rw-r--r--run.c31
-rw-r--r--scope.c39
-rw-r--r--sv.c56
-rw-r--r--sv.h4
-rw-r--r--thread.h235
-rw-r--r--toke.c44
-rw-r--r--util.c57
33 files changed, 2156 insertions, 1149 deletions
diff --git a/XSUB.h b/XSUB.h
index a7987f419e..8cb3b86a11 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -7,7 +7,7 @@
#endif
#define dXSARGS \
- dSP; dMARK; \
+ dTHR; dSP; dMARK; \
I32 ax = mark - stack_base + 1; \
I32 items = sp - mark
diff --git a/av.c b/av.c
index af3e94e8bc..b9382a8d9c 100644
--- a/av.c
+++ b/av.c
@@ -30,8 +30,10 @@ AV* av;
while (key) {
sv = AvARRAY(av)[--key];
assert(sv);
- if (sv != &sv_undef)
+ if (sv != &sv_undef) {
+ dTHR;
(void)SvREFCNT_inc(sv);
+ }
}
key = AvARRAY(av) - AvALLOC(av);
while (key)
@@ -44,6 +46,7 @@ av_extend(av,key)
AV *av;
I32 key;
{
+ dTHR; /* only necessary if we have to extend stack */
if (key > AvMAX(av)) {
SV** ary;
I32 tmp;
@@ -134,6 +137,7 @@ I32 lval;
if (SvRMAGICAL(av)) {
if (mg_find((SV*)av,'P')) {
+ dTHR;
sv = sv_newmortal();
mg_copy((SV*)av, sv, 0, key);
Sv = sv;
@@ -207,6 +211,7 @@ SV *val;
ary = AvARRAY(av);
if (AvFILL(av) < key) {
if (!AvREAL(av)) {
+ dTHR;
if (av == curstack && key > stack_sp - stack_base)
stack_sp = stack_base + key; /* XPUSH in disguise */
do
diff --git a/cv.h b/cv.h
index 262d44c635..97dfeb6f6d 100644
--- a/cv.h
+++ b/cv.h
@@ -28,6 +28,11 @@ struct xpvcv {
long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
+#ifdef USE_THREADS
+ pthread_mutex_t * xcv_mutexp;
+ pthread_cond_t * xcv_condp; /* signalled when owner leaves CV */
+ struct thread * xcv_owner; /* current owner thread */
+#endif /* USE_THREADS */
U8 xcv_flags;
};
@@ -43,6 +48,11 @@ struct xpvcv {
#define CvDEPTH(sv) ((XPVCV*)SvANY(sv))->xcv_depth
#define CvPADLIST(sv) ((XPVCV*)SvANY(sv))->xcv_padlist
#define CvOUTSIDE(sv) ((XPVCV*)SvANY(sv))->xcv_outside
+#ifdef USE_THREADS
+#define CvMUTEXP(sv) ((XPVCV*)SvANY(sv))->xcv_mutexp
+#define CvCONDP(sv) ((XPVCV*)SvANY(sv))->xcv_condp
+#define CvOWNER(sv) ((XPVCV*)SvANY(sv))->xcv_owner
+#endif /* USE_THREADS */
#define CvFLAGS(sv) ((XPVCV*)SvANY(sv))->xcv_flags
#define CVf_CLONE 0x01 /* anon CV uses external lexicals */
diff --git a/deb.c b/deb.c
index 8058d1a3b3..01463c90a6 100644
--- a/deb.c
+++ b/deb.c
@@ -27,12 +27,20 @@ void
deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
char *pat;
{
+ dTHR;
register I32 i;
GV* gv = curcop->cop_filegv;
+#ifdef USE_THREADS
+ PerlIO_printf(Perl_debug_log,"0x%lx (%s:%ld)\t",
+ (unsigned long) thr,
+ SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+ (long)curcop->cop_line);
+#else
PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
(long)curcop->cop_line);
+#endif /* USE_THREADS */
for (i=0; i<dlevel; i++)
PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
PerlIO_printf(Perl_debug_log, pat,a1,a2,a3,a4,a5,a6,a7,a8);
@@ -51,13 +59,21 @@ deb(pat, va_alist)
va_dcl
# endif
{
+ dTHR;
va_list args;
register I32 i;
GV* gv = curcop->cop_filegv;
+#ifdef USE_THREADS
+ PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
+ (unsigned long) thr,
+ SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+ (long)curcop->cop_line);
+#else
PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
(long)curcop->cop_line);
+#endif /* USE_THREADS */
for (i=0; i<dlevel; i++)
PerlIO_printf(Perl_debug_log, "%c%c ",debname[i],debdelim[i]);
@@ -82,6 +98,7 @@ deb_growlevel()
I32
debstackptrs()
{
+ dTHR;
PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
(unsigned long)curstack, (unsigned long)stack_base,
(long)*markstack_ptr, (long)(stack_sp-stack_base),
@@ -95,6 +112,7 @@ debstackptrs()
I32
debstack()
{
+ dTHR;
I32 top = stack_sp - stack_base;
register I32 i = top - 30;
I32 *markscan = markstack;
@@ -106,7 +124,12 @@ debstack()
if (*markscan >= i)
break;
+#ifdef USE_THREADS
+ PerlIO_printf(Perl_debug_log, i ? "0x%lx => ... " : "0x%lx => ",
+ (unsigned long) thr);
+#else
PerlIO_printf(Perl_debug_log, i ? " => ... " : " => ");
+#endif /* USE_THREADS */
if (stack_base[0] != &sv_undef || stack_sp < stack_base)
PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
do {
diff --git a/doio.c b/doio.c
index 0d57425269..9ffe37007c 100644
--- a/doio.c
+++ b/doio.c
@@ -384,6 +384,7 @@ register GV *gv;
}
filemode = 0;
while (av_len(GvAV(gv)) >= 0) {
+ dTHR;
STRLEN len;
sv = av_shift(GvAV(gv));
SAVEFREESV(sv);
@@ -621,6 +622,7 @@ bool
do_eof(gv)
GV *gv;
{
+ dTHR;
register IO *io;
int ch;
@@ -905,6 +907,7 @@ register SV **sp;
char *tmps;
if (sp > mark) {
+ dTHR;
New(401,Argv, sp - mark + 1, char*);
a = Argv;
while (++mark <= sp) {
@@ -1039,6 +1042,7 @@ I32 type;
register SV **mark;
register SV **sp;
{
+ dTHR;
register I32 val;
register I32 val2;
register I32 tot = 0;
@@ -1292,6 +1296,7 @@ I32 optype;
SV **mark;
SV **sp;
{
+ dTHR;
key_t key;
I32 n, flags;
@@ -1327,6 +1332,7 @@ I32 optype;
SV **mark;
SV **sp;
{
+ dTHR;
SV *astr;
char *a;
I32 id, n, cmd, infosize, getinfo;
@@ -1429,6 +1435,7 @@ SV **mark;
SV **sp;
{
#ifdef HAS_MSG
+ dTHR;
SV *mstr;
char *mbuf;
I32 id, msize, flags;
@@ -1453,6 +1460,7 @@ SV **mark;
SV **sp;
{
#ifdef HAS_MSG
+ dTHR;
SV *mstr;
char *mbuf;
long mtype;
@@ -1491,6 +1499,7 @@ SV **mark;
SV **sp;
{
#ifdef HAS_SEM
+ dTHR;
SV *opstr;
char *opbuf;
I32 id;
@@ -1518,6 +1527,7 @@ SV **mark;
SV **sp;
{
#ifdef HAS_SHM
+ dTHR;
SV *mstr;
char *mbuf, *shm;
I32 id, mpos, msize;
diff --git a/doop.c b/doop.c
index 3a21803f98..378055fd9c 100644
--- a/doop.c
+++ b/doop.c
@@ -23,6 +23,7 @@ do_trans(sv,arg)
SV *sv;
OP *arg;
{
+ dTHR;
register short *tbl;
register U8 *s;
register U8 *send;
diff --git a/dump.c b/dump.c
index 9bd51acc00..cf9cf5deb0 100644
--- a/dump.c
+++ b/dump.c
@@ -31,6 +31,7 @@ static void dump();
void
dump_all()
{
+ dTHR;
PerlIO_setlinebuf(Perl_debug_log);
if (main_root)
dump_op(main_root);
@@ -41,6 +42,7 @@ void
dump_packsubs(stash)
HV* stash;
{
+ dTHR;
I32 i;
HE *entry;
@@ -100,36 +102,36 @@ dump_eval()
}
void
-dump_op(op)
-register OP *op;
+dump_op(o)
+register OP *o;
{
dump("{\n");
- if (op->op_seq)
- PerlIO_printf(Perl_debug_log, "%-4d", op->op_seq);
+ if (o->op_seq)
+ PerlIO_printf(Perl_debug_log, "%-4d", o->op_seq);
else
PerlIO_printf(Perl_debug_log, " ");
- dump("TYPE = %s ===> ", op_name[op->op_type]);
- if (op->op_next) {
- if (op->op_seq)
- PerlIO_printf(Perl_debug_log, "%d\n", op->op_next->op_seq);
+ dump("TYPE = %s ===> ", op_name[o->op_type]);
+ if (o->op_next) {
+ if (o->op_seq)
+ PerlIO_printf(Perl_debug_log, "%d\n", o->op_next->op_seq);
else
- PerlIO_printf(Perl_debug_log, "(%d)\n", op->op_next->op_seq);
+ PerlIO_printf(Perl_debug_log, "(%d)\n", o->op_next->op_seq);
}
else
PerlIO_printf(Perl_debug_log, "DONE\n");
dumplvl++;
- if (op->op_targ) {
- if (op->op_type == OP_NULL)
- dump(" (was %s)\n", op_name[op->op_targ]);
+ if (o->op_targ) {
+ if (o->op_type == OP_NULL)
+ dump(" (was %s)\n", op_name[o->op_targ]);
else
- dump("TARG = %d\n", op->op_targ);
+ dump("TARG = %d\n", o->op_targ);
}
#ifdef DUMPADDR
- dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next);
+ dump("ADDR = 0x%lx => 0x%lx\n",o, o->op_next);
#endif
- if (op->op_flags) {
+ if (o->op_flags) {
SV *tmpsv = newSVpv("", 0);
- switch (op->op_flags & OPf_WANT) {
+ switch (o->op_flags & OPf_WANT) {
case OPf_WANT_VOID:
sv_catpv(tmpsv, ",VOID");
break;
@@ -143,58 +145,58 @@ register OP *op;
sv_catpv(tmpsv, ",UNKNOWN");
break;
}
- if (op->op_flags & OPf_KIDS)
+ if (o->op_flags & OPf_KIDS)
sv_catpv(tmpsv, ",KIDS");
- if (op->op_flags & OPf_PARENS)
+ if (o->op_flags & OPf_PARENS)
sv_catpv(tmpsv, ",PARENS");
- if (op->op_flags & OPf_STACKED)
+ if (o->op_flags & OPf_STACKED)
sv_catpv(tmpsv, ",STACKED");
- if (op->op_flags & OPf_REF)
+ if (o->op_flags & OPf_REF)
sv_catpv(tmpsv, ",REF");
- if (op->op_flags & OPf_MOD)
+ if (o->op_flags & OPf_MOD)
sv_catpv(tmpsv, ",MOD");
- if (op->op_flags & OPf_SPECIAL)
+ if (o->op_flags & OPf_SPECIAL)
sv_catpv(tmpsv, ",SPECIAL");
dump("FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
}
- if (op->op_private) {
+ if (o->op_private) {
SV *tmpsv = newSVpv("", 0);
- if (op->op_type == OP_AASSIGN) {
- if (op->op_private & OPpASSIGN_COMMON)
+ if (o->op_type == OP_AASSIGN) {
+ if (o->op_private & OPpASSIGN_COMMON)
sv_catpv(tmpsv, ",COMMON");
}
- else if (op->op_type == OP_SASSIGN) {
- if (op->op_private & OPpASSIGN_BACKWARDS)
+ else if (o->op_type == OP_SASSIGN) {
+ if (o->op_private & OPpASSIGN_BACKWARDS)
sv_catpv(tmpsv, ",BACKWARDS");
}
- else if (op->op_type == OP_TRANS) {
- if (op->op_private & OPpTRANS_SQUASH)
+ else if (o->op_type == OP_TRANS) {
+ if (o->op_private & OPpTRANS_SQUASH)
sv_catpv(tmpsv, ",SQUASH");
- if (op->op_private & OPpTRANS_DELETE)
+ if (o->op_private & OPpTRANS_DELETE)
sv_catpv(tmpsv, ",DELETE");
- if (op->op_private & OPpTRANS_COMPLEMENT)
+ if (o->op_private & OPpTRANS_COMPLEMENT)
sv_catpv(tmpsv, ",COMPLEMENT");
}
- else if (op->op_type == OP_REPEAT) {
- if (op->op_private & OPpREPEAT_DOLIST)
+ else if (o->op_type == OP_REPEAT) {
+ if (o->op_private & OPpREPEAT_DOLIST)
sv_catpv(tmpsv, ",DOLIST");
}
- else if (op->op_type == OP_ENTERSUB ||
- op->op_type == OP_RV2SV ||
- op->op_type == OP_RV2AV ||
- op->op_type == OP_RV2HV ||
- op->op_type == OP_RV2GV ||
- op->op_type == OP_AELEM ||
- op->op_type == OP_HELEM )
+ else if (o->op_type == OP_ENTERSUB ||
+ o->op_type == OP_RV2SV ||
+ o->op_type == OP_RV2AV ||
+ o->op_type == OP_RV2HV ||
+ o->op_type == OP_RV2GV ||
+ o->op_type == OP_AELEM ||
+ o->op_type == OP_HELEM )
{
- if (op->op_type == OP_ENTERSUB) {
- if (op->op_private & OPpENTERSUB_AMPER)
+ if (o->op_type == OP_ENTERSUB) {
+ if (o->op_private & OPpENTERSUB_AMPER)
sv_catpv(tmpsv, ",AMPER");
- if (op->op_private & OPpENTERSUB_DB)
+ if (o->op_private & OPpENTERSUB_DB)
sv_catpv(tmpsv, ",DB");
}
- switch (op->op_private & OPpDEREF) {
+ switch (o->op_private & OPpDEREF) {
case OPpDEREF_SV:
sv_catpv(tmpsv, ",SV");
break;
@@ -205,42 +207,42 @@ register OP *op;
sv_catpv(tmpsv, ",HV");
break;
}
- if (op->op_type == OP_AELEM || op->op_type == OP_HELEM) {
- if (op->op_private & OPpLVAL_DEFER)
+ if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
+ if (o->op_private & OPpLVAL_DEFER)
sv_catpv(tmpsv, ",LVAL_DEFER");
}
else {
- if (op->op_private & HINT_STRICT_REFS)
+ if (o->op_private & HINT_STRICT_REFS)
sv_catpv(tmpsv, ",STRICT_REFS");
}
}
- else if (op->op_type == OP_CONST) {
- if (op->op_private & OPpCONST_BARE)
+ else if (o->op_type == OP_CONST) {
+ if (o->op_private & OPpCONST_BARE)
sv_catpv(tmpsv, ",BARE");
}
- else if (op->op_type == OP_FLIP) {
- if (op->op_private & OPpFLIP_LINENUM)
+ else if (o->op_type == OP_FLIP) {
+ if (o->op_private & OPpFLIP_LINENUM)
sv_catpv(tmpsv, ",LINENUM");
}
- else if (op->op_type == OP_FLOP) {
- if (op->op_private & OPpFLIP_LINENUM)
+ else if (o->op_type == OP_FLOP) {
+ if (o->op_private & OPpFLIP_LINENUM)
sv_catpv(tmpsv, ",LINENUM");
}
- if (op->op_flags & OPf_MOD && op->op_private & OPpLVAL_INTRO)
+ if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
sv_catpv(tmpsv, ",INTRO");
if (SvCUR(tmpsv))
dump("PRIVATE = (%s)\n", SvPVX(tmpsv) + 1);
SvREFCNT_dec(tmpsv);
}
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_GVSV:
case OP_GV:
- if (cGVOP->op_gv) {
+ if (cGVOPo->op_gv) {
SV *tmpsv = NEWSV(0,0);
ENTER;
SAVEFREESV(tmpsv);
- gv_fullname3(tmpsv, cGVOP->op_gv, Nullch);
+ gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch);
dump("GV = %s\n", SvPV(tmpsv, na));
LEAVE;
}
@@ -248,41 +250,41 @@ register OP *op;
dump("GV = NULL\n");
break;
case OP_CONST:
- dump("SV = %s\n", SvPEEK(cSVOP->op_sv));
+ dump("SV = %s\n", SvPEEK(cSVOPo->op_sv));
break;
case OP_NEXTSTATE:
case OP_DBSTATE:
- if (cCOP->cop_line)
- dump("LINE = %d\n",cCOP->cop_line);
- if (cCOP->cop_label)
- dump("LABEL = \"%s\"\n",cCOP->cop_label);
+ if (cCOPo->cop_line)
+ dump("LINE = %d\n",cCOPo->cop_line);
+ if (cCOPo->cop_label)
+ dump("LABEL = \"%s\"\n",cCOPo->cop_label);
break;
case OP_ENTERLOOP:
dump("REDO ===> ");
- if (cLOOP->op_redoop)
- PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_redoop->op_seq);
+ if (cLOOPo->op_redoop)
+ PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_redoop->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
dump("NEXT ===> ");
- if (cLOOP->op_nextop)
- PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_nextop->op_seq);
+ if (cLOOPo->op_nextop)
+ PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_nextop->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
dump("LAST ===> ");
- if (cLOOP->op_lastop)
- PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_lastop->op_seq);
+ if (cLOOPo->op_lastop)
+ PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_lastop->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
break;
case OP_COND_EXPR:
dump("TRUE ===> ");
- if (cCONDOP->op_true)
- PerlIO_printf(Perl_debug_log, "%d\n", cCONDOP->op_true->op_seq);
+ if (cCONDOPo->op_true)
+ PerlIO_printf(Perl_debug_log, "%d\n", cCONDOPo->op_true->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
dump("FALSE ===> ");
- if (cCONDOP->op_false)
- PerlIO_printf(Perl_debug_log, "%d\n", cCONDOP->op_false->op_seq);
+ if (cCONDOPo->op_false)
+ PerlIO_printf(Perl_debug_log, "%d\n", cCONDOPo->op_false->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
break;
@@ -291,22 +293,22 @@ register OP *op;
case OP_OR:
case OP_AND:
dump("OTHER ===> ");
- if (cLOGOP->op_other)
- PerlIO_printf(Perl_debug_log, "%d\n", cLOGOP->op_other->op_seq);
+ if (cLOGOPo->op_other)
+ PerlIO_printf(Perl_debug_log, "%d\n", cLOGOPo->op_other->op_seq);
else
PerlIO_printf(Perl_debug_log, "DONE\n");
break;
case OP_PUSHRE:
case OP_MATCH:
case OP_SUBST:
- dump_pm((PMOP*)op);
+ dump_pm(cPMOPo);
break;
default:
break;
}
- if (op->op_flags & OPf_KIDS) {
+ if (o->op_flags & OPf_KIDS) {
OP *kid;
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
dump_op(kid);
}
dumplvl--;
diff --git a/embed.h b/embed.h
index 0ad53a7af4..dcaca387c6 100644
--- a/embed.h
+++ b/embed.h
@@ -50,6 +50,18 @@
#define av_store Perl_av_store
#define av_undef Perl_av_undef
#define av_unshift Perl_av_unshift
+#define avhv_delete Perl_avhv_delete
+#define avhv_delete_ent Perl_avhv_delete_ent
+#define avhv_exists Perl_avhv_exists
+#define avhv_exists_ent Perl_avhv_exists_ent
+#define avhv_fetch Perl_avhv_fetch
+#define avhv_fetch_ent Perl_avhv_fetch_ent
+#define avhv_iterinit Perl_avhv_iterinit
+#define avhv_iternext Perl_avhv_iternext
+#define avhv_iternextsv Perl_avhv_iternextsv
+#define avhv_iterval Perl_avhv_iterval
+#define avhv_store Perl_avhv_store
+#define avhv_store_ent Perl_avhv_store_ent
#define band_amg Perl_band_amg
#define bind_match Perl_bind_match
#define block_end Perl_block_end
@@ -264,6 +276,7 @@
#define ibcmp Perl_ibcmp
#define ibcmp_locale Perl_ibcmp_locale
#define in_my Perl_in_my
+#define in_my_stash Perl_in_my_stash
#define inc_amg Perl_inc_amg
#define ingroup Perl_ingroup
#define instr Perl_instr
@@ -1295,6 +1308,7 @@
#define preambleav (curinterp->Ipreambleav)
#define preambled (curinterp->Ipreambled)
#define preprocess (curinterp->Ipreprocess)
+#define restartav (curinterp->Irestartav)
#define restartop (curinterp->Irestartop)
#define rightgv (curinterp->Irightgv)
#define rs (curinterp->Irs)
@@ -1449,6 +1463,7 @@
#define Ipreambleav preambleav
#define Ipreambled preambled
#define Ipreprocess preprocess
+#define Irestartav restartav
#define Irestartop restartop
#define Irightgv rightgv
#define Irs rs
@@ -1612,6 +1627,7 @@
#define preambleav Perl_preambleav
#define preambled Perl_preambled
#define preprocess Perl_preprocess
+#define restartav Perl_restartav
#define restartop Perl_restartop
#define rightgv Perl_rightgv
#define rs Perl_rs
diff --git a/global.sym b/global.sym
index 27d80c5dc3..219e9a518e 100644
--- a/global.sym
+++ b/global.sym
@@ -255,6 +255,7 @@ vtbl_glob
vtbl_isa
vtbl_isaelem
vtbl_mglob
+vtbl_mutex
vtbl_nkeys
vtbl_pack
vtbl_packelem
@@ -372,6 +373,7 @@ ck_split
ck_subr
ck_svconst
ck_trunc
+condpair_magic
convert
croak
cv_ckproto
@@ -492,6 +494,7 @@ hv_undef
ibcmp
ibcmp_locale
ingroup
+init_stacks
instr
intro_my
intuit_more
@@ -521,6 +524,7 @@ magic_getsig
magic_gettaint
magic_getuvar
magic_len
+magic_mutexfree
magic_nextpack
magic_set
magic_setamagic
diff --git a/gv.c b/gv.c
index 6c912a0e9b..c9f919ccc2 100644
--- a/gv.c
+++ b/gv.c
@@ -420,6 +420,7 @@ char *nambeg;
I32 add;
I32 sv_type;
{
+ dTHR;
register char *name = nambeg;
register GV *gv = 0;
GV**gvp;
@@ -820,6 +821,7 @@ GV *gv;
IO *
newIO()
{
+ dTHR;
IO *io;
GV *iogv;
@@ -836,6 +838,7 @@ void
gv_check(stash)
HV* stash;
{
+ dTHR;
register HE *entry;
register I32 i;
register GV *gv;
@@ -963,6 +966,7 @@ bool
Gv_AMupdate(stash)
HV* stash;
{
+ dTHR;
GV** gvp;
HV* hv;
GV* gv;
@@ -1126,6 +1130,7 @@ SV* right;
int method;
int flags;
{
+ dTHR;
MAGIC *mg;
CV *cv;
CV **cvp=NULL, **ocvp=NULL;
@@ -1325,6 +1330,7 @@ int flags;
|| inc_dec_ass) RvDEEPCP(left);
}
{
+ dTHR;
dSP;
BINOP myop;
SV* res;
@@ -1342,7 +1348,7 @@ int flags;
if (perldb && curstash != debstash)
op->op_private |= OPpENTERSUB_DB;
PUTBACK;
- pp_pushmark();
+ pp_pushmark(ARGS);
EXTEND(sp, notfound + 5);
PUSHs(lr>0? right: left);
@@ -1354,7 +1360,7 @@ int flags;
PUSHs((SV*)cv);
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
LEAVE;
SPAGAIN;
diff --git a/hv.c b/hv.c
index f63dff871a..77c379884a 100644
--- a/hv.c
+++ b/hv.c
@@ -100,6 +100,7 @@ I32 lval;
if (SvRMAGICAL(hv)) {
if (mg_find((SV*)hv,'P')) {
+ dTHR;
sv = sv_newmortal();
mg_copy((SV*)hv, sv, key, klen);
Sv = sv;
@@ -511,6 +512,7 @@ U32 klen;
if (SvRMAGICAL(hv)) {
if (mg_find((SV*)hv,'P')) {
+ dTHR;
sv = sv_newmortal();
mg_copy((SV*)hv, sv, key, klen);
magic_existspack(sv, mg_find(sv, 'p'));
diff --git a/keywords.h b/keywords.h
index a6dabf3e61..7d7164945f 100644
--- a/keywords.h
+++ b/keywords.h
@@ -1,246 +1,248 @@
#define KEY_NULL 0
-#define KEY___LINE__ 1
-#define KEY___FILE__ 2
-#define KEY___DATA__ 3
-#define KEY___END__ 4
-#define KEY_AUTOLOAD 5
-#define KEY_BEGIN 6
-#define KEY_CORE 7
-#define KEY_DESTROY 8
-#define KEY_END 9
-#define KEY_EQ 10
-#define KEY_GE 11
-#define KEY_GT 12
-#define KEY_LE 13
-#define KEY_LT 14
-#define KEY_NE 15
-#define KEY_RESTART 16
-#define KEY_abs 17
-#define KEY_accept 18
-#define KEY_alarm 19
-#define KEY_and 20
-#define KEY_atan2 21
-#define KEY_bind 22
-#define KEY_binmode 23
-#define KEY_bless 24
-#define KEY_caller 25
-#define KEY_chdir 26
-#define KEY_chmod 27
-#define KEY_chomp 28
-#define KEY_chop 29
-#define KEY_chown 30
-#define KEY_chr 31
-#define KEY_chroot 32
-#define KEY_close 33
-#define KEY_closedir 34
-#define KEY_cmp 35
-#define KEY_connect 36
-#define KEY_continue 37
-#define KEY_cos 38
-#define KEY_crypt 39
-#define KEY_dbmclose 40
-#define KEY_dbmopen 41
-#define KEY_defined 42
-#define KEY_delete 43
-#define KEY_die 44
-#define KEY_do 45
-#define KEY_dump 46
-#define KEY_each 47
-#define KEY_else 48
-#define KEY_elsif 49
-#define KEY_endgrent 50
-#define KEY_endhostent 51
-#define KEY_endnetent 52
-#define KEY_endprotoent 53
-#define KEY_endpwent 54
-#define KEY_endservent 55
-#define KEY_eof 56
-#define KEY_eq 57
-#define KEY_eval 58
-#define KEY_exec 59
-#define KEY_exists 60
-#define KEY_exit 61
-#define KEY_exp 62
-#define KEY_fcntl 63
-#define KEY_fileno 64
-#define KEY_flock 65
-#define KEY_for 66
-#define KEY_foreach 67
-#define KEY_fork 68
-#define KEY_format 69
-#define KEY_formline 70
-#define KEY_ge 71
-#define KEY_getc 72
-#define KEY_getgrent 73
-#define KEY_getgrgid 74
-#define KEY_getgrnam 75
-#define KEY_gethostbyaddr 76
-#define KEY_gethostbyname 77
-#define KEY_gethostent 78
-#define KEY_getlogin 79
-#define KEY_getnetbyaddr 80
-#define KEY_getnetbyname 81
-#define KEY_getnetent 82
-#define KEY_getpeername 83
-#define KEY_getpgrp 84
-#define KEY_getppid 85
-#define KEY_getpriority 86
-#define KEY_getprotobyname 87
-#define KEY_getprotobynumber 88
-#define KEY_getprotoent 89
-#define KEY_getpwent 90
-#define KEY_getpwnam 91
-#define KEY_getpwuid 92
-#define KEY_getservbyname 93
-#define KEY_getservbyport 94
-#define KEY_getservent 95
-#define KEY_getsockname 96
-#define KEY_getsockopt 97
-#define KEY_glob 98
-#define KEY_gmtime 99
-#define KEY_goto 100
-#define KEY_grep 101
-#define KEY_gt 102
-#define KEY_hex 103
-#define KEY_if 104
-#define KEY_index 105
-#define KEY_int 106
-#define KEY_ioctl 107
-#define KEY_join 108
-#define KEY_keys 109
-#define KEY_kill 110
-#define KEY_last 111
-#define KEY_lc 112
-#define KEY_lcfirst 113
-#define KEY_le 114
-#define KEY_length 115
-#define KEY_link 116
-#define KEY_listen 117
-#define KEY_local 118
-#define KEY_localtime 119
-#define KEY_log 120
-#define KEY_lstat 121
-#define KEY_lt 122
-#define KEY_m 123
-#define KEY_map 124
-#define KEY_mkdir 125
-#define KEY_msgctl 126
-#define KEY_msgget 127
-#define KEY_msgrcv 128
-#define KEY_msgsnd 129
-#define KEY_my 130
-#define KEY_ne 131
-#define KEY_next 132
-#define KEY_no 133
-#define KEY_not 134
-#define KEY_oct 135
-#define KEY_open 136
-#define KEY_opendir 137
-#define KEY_or 138
-#define KEY_ord 139
-#define KEY_pack 140
-#define KEY_package 141
-#define KEY_pipe 142
-#define KEY_pop 143
-#define KEY_pos 144
-#define KEY_print 145
-#define KEY_printf 146
-#define KEY_prototype 147
-#define KEY_push 148
-#define KEY_q 149
-#define KEY_qq 150
-#define KEY_quotemeta 151
-#define KEY_qw 152
-#define KEY_qx 153
-#define KEY_rand 154
-#define KEY_read 155
-#define KEY_readdir 156
-#define KEY_readline 157
-#define KEY_readlink 158
-#define KEY_readpipe 159
-#define KEY_recv 160
-#define KEY_redo 161
-#define KEY_ref 162
-#define KEY_rename 163
-#define KEY_require 164
-#define KEY_reset 165
-#define KEY_return 166
-#define KEY_reverse 167
-#define KEY_rewinddir 168
-#define KEY_rindex 169
-#define KEY_rmdir 170
-#define KEY_s 171
-#define KEY_scalar 172
-#define KEY_seek 173
-#define KEY_seekdir 174
-#define KEY_select 175
-#define KEY_semctl 176
-#define KEY_semget 177
-#define KEY_semop 178
-#define KEY_send 179
-#define KEY_setgrent 180
-#define KEY_sethostent 181
-#define KEY_setnetent 182
-#define KEY_setpgrp 183
-#define KEY_setpriority 184
-#define KEY_setprotoent 185
-#define KEY_setpwent 186
-#define KEY_setservent 187
-#define KEY_setsockopt 188
-#define KEY_shift 189
-#define KEY_shmctl 190
-#define KEY_shmget 191
-#define KEY_shmread 192
-#define KEY_shmwrite 193
-#define KEY_shutdown 194
-#define KEY_sin 195
-#define KEY_sleep 196
-#define KEY_socket 197
-#define KEY_socketpair 198
-#define KEY_sort 199
-#define KEY_splice 200
-#define KEY_split 201
-#define KEY_sprintf 202
-#define KEY_sqrt 203
-#define KEY_srand 204
-#define KEY_stat 205
-#define KEY_study 206
-#define KEY_sub 207
-#define KEY_substr 208
-#define KEY_symlink 209
-#define KEY_syscall 210
-#define KEY_sysopen 211
-#define KEY_sysread 212
-#define KEY_system 213
-#define KEY_syswrite 214
-#define KEY_tell 215
-#define KEY_telldir 216
-#define KEY_tie 217
-#define KEY_tied 218
-#define KEY_time 219
-#define KEY_times 220
-#define KEY_tr 221
-#define KEY_truncate 222
-#define KEY_uc 223
-#define KEY_ucfirst 224
-#define KEY_umask 225
-#define KEY_undef 226
-#define KEY_unless 227
-#define KEY_unlink 228
-#define KEY_unpack 229
-#define KEY_unshift 230
-#define KEY_untie 231
-#define KEY_until 232
-#define KEY_use 233
-#define KEY_utime 234
-#define KEY_values 235
-#define KEY_vec 236
-#define KEY_wait 237
-#define KEY_waitpid 238
-#define KEY_wantarray 239
-#define KEY_warn 240
-#define KEY_while 241
-#define KEY_write 242
-#define KEY_x 243
-#define KEY_xor 244
-#define KEY_y 245
+#define KEY___FILE__ 1
+#define KEY___LINE__ 2
+#define KEY___PACKAGE__ 3
+#define KEY___DATA__ 4
+#define KEY___END__ 5
+#define KEY_AUTOLOAD 6
+#define KEY_BEGIN 7
+#define KEY_CORE 8
+#define KEY_DESTROY 9
+#define KEY_END 10
+#define KEY_EQ 11
+#define KEY_GE 12
+#define KEY_GT 13
+#define KEY_LE 14
+#define KEY_LT 15
+#define KEY_NE 16
+#define KEY_RESTART 17
+#define KEY_abs 18
+#define KEY_accept 19
+#define KEY_alarm 20
+#define KEY_and 21
+#define KEY_atan2 22
+#define KEY_bind 23
+#define KEY_binmode 24
+#define KEY_bless 25
+#define KEY_caller 26
+#define KEY_chdir 27
+#define KEY_chmod 28
+#define KEY_chomp 29
+#define KEY_chop 30
+#define KEY_chown 31
+#define KEY_chr 32
+#define KEY_chroot 33
+#define KEY_close 34
+#define KEY_closedir 35
+#define KEY_cmp 36
+#define KEY_connect 37
+#define KEY_continue 38
+#define KEY_cos 39
+#define KEY_crypt 40
+#define KEY_dbmclose 41
+#define KEY_dbmopen 42
+#define KEY_defined 43
+#define KEY_delete 44
+#define KEY_die 45
+#define KEY_do 46
+#define KEY_dump 47
+#define KEY_each 48
+#define KEY_else 49
+#define KEY_elsif 50
+#define KEY_endgrent 51
+#define KEY_endhostent 52
+#define KEY_endnetent 53
+#define KEY_endprotoent 54
+#define KEY_endpwent 55
+#define KEY_endservent 56
+#define KEY_eof 57
+#define KEY_eq 58
+#define KEY_eval 59
+#define KEY_exec 60
+#define KEY_exists 61
+#define KEY_exit 62
+#define KEY_exp 63
+#define KEY_fcntl 64
+#define KEY_fileno 65
+#define KEY_flock 66
+#define KEY_for 67
+#define KEY_foreach 68
+#define KEY_fork 69
+#define KEY_format 70
+#define KEY_formline 71
+#define KEY_ge 72
+#define KEY_getc 73
+#define KEY_getgrent 74
+#define KEY_getgrgid 75
+#define KEY_getgrnam 76
+#define KEY_gethostbyaddr 77
+#define KEY_gethostbyname 78
+#define KEY_gethostent 79
+#define KEY_getlogin 80
+#define KEY_getnetbyaddr 81
+#define KEY_getnetbyname 82
+#define KEY_getnetent 83
+#define KEY_getpeername 84
+#define KEY_getpgrp 85
+#define KEY_getppid 86
+#define KEY_getpriority 87
+#define KEY_getprotobyname 88
+#define KEY_getprotobynumber 89
+#define KEY_getprotoent 90
+#define KEY_getpwent 91
+#define KEY_getpwnam 92
+#define KEY_getpwuid 93
+#define KEY_getservbyname 94
+#define KEY_getservbyport 95
+#define KEY_getservent 96
+#define KEY_getsockname 97
+#define KEY_getsockopt 98
+#define KEY_glob 99
+#define KEY_gmtime 100
+#define KEY_goto 101
+#define KEY_grep 102
+#define KEY_gt 103
+#define KEY_hex 104
+#define KEY_if 105
+#define KEY_index 106
+#define KEY_int 107
+#define KEY_ioctl 108
+#define KEY_join 109
+#define KEY_keys 110
+#define KEY_kill 111
+#define KEY_last 112
+#define KEY_lc 113
+#define KEY_lcfirst 114
+#define KEY_le 115
+#define KEY_length 116
+#define KEY_link 117
+#define KEY_listen 118
+#define KEY_local 119
+#define KEY_localtime 120
+#define KEY_log 121
+#define KEY_lstat 122
+#define KEY_lt 123
+#define KEY_m 124
+#define KEY_map 125
+#define KEY_mkdir 126
+#define KEY_msgctl 127
+#define KEY_msgget 128
+#define KEY_msgrcv 129
+#define KEY_msgsnd 130
+#define KEY_my 131
+#define KEY_ne 132
+#define KEY_next 133
+#define KEY_no 134
+#define KEY_not 135
+#define KEY_oct 136
+#define KEY_open 137
+#define KEY_opendir 138
+#define KEY_or 139
+#define KEY_ord 140
+#define KEY_pack 141
+#define KEY_package 142
+#define KEY_pipe 143
+#define KEY_pop 144
+#define KEY_pos 145
+#define KEY_print 146
+#define KEY_printf 147
+#define KEY_prototype 148
+#define KEY_push 149
+#define KEY_q 150
+#define KEY_qq 151
+#define KEY_quotemeta 152
+#define KEY_qw 153
+#define KEY_qx 154
+#define KEY_rand 155
+#define KEY_read 156
+#define KEY_readdir 157
+#define KEY_readline 158
+#define KEY_readlink 159
+#define KEY_readpipe 160
+#define KEY_recv 161
+#define KEY_redo 162
+#define KEY_ref 163
+#define KEY_rename 164
+#define KEY_require 165
+#define KEY_reset 166
+#define KEY_return 167
+#define KEY_reverse 168
+#define KEY_rewinddir 169
+#define KEY_rindex 170
+#define KEY_rmdir 171
+#define KEY_s 172
+#define KEY_scalar 173
+#define KEY_seek 174
+#define KEY_seekdir 175
+#define KEY_select 176
+#define KEY_semctl 177
+#define KEY_semget 178
+#define KEY_semop 179
+#define KEY_send 180
+#define KEY_setgrent 181
+#define KEY_sethostent 182
+#define KEY_setnetent 183
+#define KEY_setpgrp 184
+#define KEY_setpriority 185
+#define KEY_setprotoent 186
+#define KEY_setpwent 187
+#define KEY_setservent 188
+#define KEY_setsockopt 189
+#define KEY_shift 190
+#define KEY_shmctl 191
+#define KEY_shmget 192
+#define KEY_shmread 193
+#define KEY_shmwrite 194
+#define KEY_shutdown 195
+#define KEY_sin 196
+#define KEY_sleep 197
+#define KEY_socket 198
+#define KEY_socketpair 199
+#define KEY_sort 200
+#define KEY_splice 201
+#define KEY_split 202
+#define KEY_sprintf 203
+#define KEY_sqrt 204
+#define KEY_srand 205
+#define KEY_stat 206
+#define KEY_study 207
+#define KEY_sub 208
+#define KEY_substr 209
+#define KEY_symlink 210
+#define KEY_syscall 211
+#define KEY_sysopen 212
+#define KEY_sysread 213
+#define KEY_sysseek 214
+#define KEY_system 215
+#define KEY_syswrite 216
+#define KEY_tell 217
+#define KEY_telldir 218
+#define KEY_tie 219
+#define KEY_tied 220
+#define KEY_time 221
+#define KEY_times 222
+#define KEY_tr 223
+#define KEY_truncate 224
+#define KEY_uc 225
+#define KEY_ucfirst 226
+#define KEY_umask 227
+#define KEY_undef 228
+#define KEY_unless 229
+#define KEY_unlink 230
+#define KEY_unpack 231
+#define KEY_unshift 232
+#define KEY_untie 233
+#define KEY_until 234
+#define KEY_use 235
+#define KEY_utime 236
+#define KEY_values 237
+#define KEY_vec 238
+#define KEY_wait 239
+#define KEY_waitpid 240
+#define KEY_wantarray 241
+#define KEY_warn 242
+#define KEY_while 243
+#define KEY_write 244
+#define KEY_x 245
+#define KEY_xor 246
+#define KEY_y 247
diff --git a/malloc.c b/malloc.c
index e9b200ba69..52c7eed928 100644
--- a/malloc.c
+++ b/malloc.c
@@ -287,6 +287,7 @@ malloc(nbytes)
#endif
#endif /* PERL_CORE */
+ MUTEX_LOCK(&malloc_mutex);
/*
* Convert amount of memory requested into
* closest block size stored in hash buckets
@@ -317,6 +318,7 @@ malloc(nbytes)
if (nextf[bucket] == NULL)
morecore(bucket);
if ((p = (union overhead *)nextf[bucket]) == NULL) {
+ MUTEX_UNLOCK(&malloc_mutex);
#ifdef PERL_CORE
if (!nomemok) {
PerlIO_puts(PerlIO_stderr(),"Out of memory!\n");
@@ -354,6 +356,7 @@ malloc(nbytes)
p->ov_rmagic = RMAGIC;
*((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
#endif
+ MUTEX_UNLOCK(&malloc_mutex);
return ((Malloc_t)(p + CHUNK_SHIFT));
}
@@ -511,6 +514,7 @@ free(mp)
#endif
return; /* sanity */
}
+ MUTEX_LOCK(&malloc_mutex);
#ifdef RCHECK
ASSERT(op->ov_rmagic == RMAGIC);
if (OV_INDEX(op) <= MAX_SHORT_BUCKET)
@@ -521,6 +525,7 @@ free(mp)
size = OV_INDEX(op);
op->ov_next = nextf[size];
nextf[size] = op;
+ MUTEX_UNLOCK(&malloc_mutex);
}
/*
@@ -568,6 +573,7 @@ realloc(mp, nbytes)
#endif
#endif /* PERL_CORE */
+ MUTEX_LOCK(&malloc_mutex);
op = (union overhead *)((caddr_t)cp
- sizeof (union overhead) * CHUNK_SHIFT);
i = OV_INDEX(op);
@@ -632,8 +638,10 @@ realloc(mp, nbytes)
}
#endif
res = cp;
+ MUTEX_UNLOCK(&malloc_mutex);
}
else {
+ MUTEX_UNLOCK(&malloc_mutex);
if ((res = (char*)malloc(nbytes)) == NULL)
return (NULL);
if (cp != res) /* common optimization */
diff --git a/mg.c b/mg.c
index cab0e5973e..cf2d71f22a 100644
--- a/mg.c
+++ b/mg.c
@@ -704,6 +704,7 @@ magic_setsig(sv,mg)
SV* sv;
MAGIC* mg;
{
+ dTHR;
register char *s;
I32 i;
SV** svp;
@@ -815,6 +816,7 @@ SV* sv;
MAGIC* mg;
char *meth;
{
+ dTHR;
dSP;
ENTER;
@@ -856,6 +858,7 @@ magic_setpack(sv,mg)
SV* sv;
MAGIC* mg;
{
+ dTHR;
dSP;
PUSHMARK(sp);
@@ -889,6 +892,7 @@ int magic_wipepack(sv,mg)
SV* sv;
MAGIC* mg;
{
+ dTHR;
dSP;
PUSHMARK(sp);
@@ -906,6 +910,7 @@ SV* sv;
MAGIC* mg;
SV* key;
{
+ dTHR;
dSP;
char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
@@ -939,6 +944,7 @@ magic_setdbline(sv,mg)
SV* sv;
MAGIC* mg;
{
+ dTHR;
OP *o;
I32 i;
GV* gv;
@@ -1093,6 +1099,7 @@ magic_settaint(sv,mg)
SV* sv;
MAGIC* mg;
{
+ dTHR;
if (localizing) {
if (localizing == 1)
mg->mg_len <<= 1;
@@ -1272,6 +1279,7 @@ magic_set(sv,mg)
SV* sv;
MAGIC* mg;
{
+ dTHR;
register char *s;
I32 i;
STRLEN len;
@@ -1605,6 +1613,21 @@ MAGIC* mg;
return 0;
}
+#ifdef USE_THREADS
+int
+magic_mutexfree(sv, mg)
+SV *sv;
+MAGIC *mg;
+{
+ dTHR;
+ if (MgOWNER(mg))
+ croak("panic: magic_mutexfree");
+ MUTEX_DESTROY(MgMUTEXP(mg));
+ COND_DESTROY(MgCONDP(mg));
+ return 0;
+}
+#endif /* USE_THREADS */
+
I32
whichsig(sig)
char *sig;
@@ -1629,6 +1652,7 @@ Signal_t
sighandler(sig)
int sig;
{
+ dTHR;
dSP;
GV *gv;
HV *st;
diff --git a/op.c b/op.c
index eae012f27b..08a2e7a8ef 100644
--- a/op.c
+++ b/op.c
@@ -18,32 +18,26 @@
#include "EXTERN.h"
#include "perl.h"
-#define USE_OP_MASK /* Turned on by default in 5.002beta1h */
-
-#ifdef USE_OP_MASK
/*
- * In the following definition, the ", (OP *) op" is just to make the compiler
+ * In the following definition, the ", Nullop" is just to make the compiler
* think the expression is of the right type: croak actually does a Siglongjmp.
*/
-#define CHECKOP(type,op) \
+#define CHECKOP(type,o) \
((op_mask && op_mask[type]) \
- ? ( op_free((OP*)op), \
+ ? ( op_free((OP*)o), \
croak("%s trapped by operation mask", op_desc[type]), \
Nullop ) \
- : (*check[type])((OP*)op))
-#else
-#define CHECKOP(type,op) (*check[type])(op)
-#endif /* USE_OP_MASK */
+ : (*check[type])((OP*)o))
-static I32 list_assignment _((OP *op));
+static I32 list_assignment _((OP *o));
static OP *bad_type _((I32 n, char *t, char *name, OP *kid));
-static OP *modkids _((OP *op, I32 type));
-static OP *no_fh_allowed _((OP *op));
-static bool scalar_mod_type _((OP *op, I32 type));
-static OP *scalarboolean _((OP *op));
-static OP *too_few_arguments _((OP *op, char* name));
-static OP *too_many_arguments _((OP *op, char* name));
-static void null _((OP* op));
+static OP *modkids _((OP *o, I32 type));
+static OP *no_fh_allowed _((OP *o));
+static bool scalar_mod_type _((OP *o, I32 type));
+static OP *scalarboolean _((OP *o));
+static OP *too_few_arguments _((OP *o, char* name));
+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));
@@ -57,33 +51,33 @@ GV* gv;
}
static OP *
-no_fh_allowed(op)
-OP *op;
+no_fh_allowed(o)
+OP *o;
{
yyerror(form("Missing comma after first argument to %s function",
op_desc[op->op_type]));
- return op;
+ return o;
}
static OP *
-too_few_arguments(op, name)
-OP* op;
+too_few_arguments(o, name)
+OP* o;
char* name;
{
yyerror(form("Not enough arguments for %s", name));
- return op;
+ return o;
}
static OP *
-too_many_arguments(op, name)
-OP *op;
+too_many_arguments(o, name)
+OP *o;
char* name;
{
yyerror(form("Too many arguments for %s", name));
- return op;
+ return o;
}
-static OP *
+static void
bad_type(n, t, name, kid)
I32 n;
char *t;
@@ -92,14 +86,13 @@ OP *kid;
{
yyerror(form("Type of arg %d to %s must be %s (not %s)",
(int)n, name, t, op_desc[kid->op_type]));
- return op;
}
void
-assertref(op)
-OP *op;
+assertref(o)
+OP *o;
{
- int type = op->op_type;
+ int type = o->op_type;
if (type != OP_AELEM && type != OP_HELEM) {
yyerror(form("Can't use subscript on %s", op_desc[type]));
if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV)
@@ -114,6 +107,7 @@ PADOFFSET
pad_allocmy(name)
char *name;
{
+ dTHR;
PADOFFSET off;
SV *sv;
@@ -176,6 +170,7 @@ I32 cx_ix;
pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
#endif
{
+ dTHR;
CV *cv;
I32 off;
SV *sv;
@@ -303,12 +298,26 @@ PADOFFSET
pad_findmy(name)
char *name;
{
+ dTHR;
I32 off;
I32 pendoff = 0;
SV *sv;
SV **svp = AvARRAY(comppad_name);
U32 seq = cop_seqmax;
+#ifdef USE_THREADS
+ /*
+ * Special case to get lexical (and hence per-thread) @_.
+ * XXX I need to find out how to tell at parse-time whether use
+ * of @_ should refer to a lexical (from a sub) or defgv (global
+ * scope and maybe weird sub-ish things like formats). See
+ * startsub in perly.y. It's possible that @_ could be lexical
+ * (at least from subs) even in non-threaded perl.
+ */
+ if (strEQ(name, "@_"))
+ return 0; /* success. (NOT_IN_PAD indicates failure) */
+#endif /* USE_THREADS */
+
/* The one we're looking for is probably just before comppad_name_fill. */
for (off = AvFILL(comppad_name); off > 0; off--) {
if ((sv = svp[off]) &&
@@ -330,10 +339,9 @@ char *name;
/* If there is a pending local definition, this new alias must die */
if (pendoff)
SvIVX(AvARRAY(comppad_name)[off]) = seq;
- return off;
+ return off; /* pad_findlex returns 0 for failure...*/
}
-
- return 0;
+ return NOT_IN_PAD; /* ...but we return NOT_IN_PAD for failure */
}
void
@@ -361,6 +369,7 @@ pad_alloc(optype,tmptype)
I32 optype;
U32 tmptype;
{
+ dTHR;
SV *sv;
I32 retval;
@@ -394,7 +403,14 @@ U32 tmptype;
}
SvFLAGS(sv) |= tmptype;
curpad = AvARRAY(comppad);
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad alloc %ld for %s\n", (long) retval, op_name[optype]));
+#ifdef USE_THREADS
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx alloc %ld for %s\n",
+ (unsigned long) thr, (unsigned long) curpad,
+ (long) retval, op_name[optype]));
+#else
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad alloc %ld for %s\n",
+ (long) retval, op_name[optype]));
+#endif /* USE_THREADS */
return (PADOFFSET)retval;
}
@@ -406,9 +422,15 @@ PADOFFSET po;
pad_sv(PADOFFSET po)
#endif /* CAN_PROTOTYPE */
{
+ dTHR;
+#ifdef USE_THREADS
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx sv %d\n",
+ (unsigned long) thr, (unsigned long) curpad, po));
+#else
if (!po)
croak("panic: pad_sv po");
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad sv %lu\n", (unsigned long)po));
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad sv %d\n", po));
+#endif /* USE_THREADS */
return curpad[po]; /* eventually we'll turn this into a macro */
}
@@ -420,14 +442,20 @@ PADOFFSET po;
pad_free(PADOFFSET po)
#endif /* CAN_PROTOTYPE */
{
+ dTHR;
if (!curpad)
return;
if (AvARRAY(comppad) != curpad)
croak("panic: pad_free curpad");
if (!po)
croak("panic: pad_free po");
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %lu\n", (unsigned long)po));
- if (curpad[po] && !SvIMMORTAL(curpad[po]))
+#ifdef USE_THREADS
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n",
+ (unsigned long) thr, (unsigned long) curpad, po));
+#else
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %d\n", po));
+#endif /* USE_THREADS */
+ if (curpad[po] && curpad[po] != &sv_undef)
SvPADTMP_off(curpad[po]);
if ((I32)po < padix)
padix = po - 1;
@@ -441,11 +469,17 @@ PADOFFSET po;
pad_swipe(PADOFFSET po)
#endif /* CAN_PROTOTYPE */
{
+ dTHR;
if (AvARRAY(comppad) != curpad)
croak("panic: pad_swipe curpad");
if (!po)
croak("panic: pad_swipe po");
- DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad swipe %lu\n", (unsigned long)po));
+#ifdef USE_THREADS
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n",
+ (unsigned long) thr, (unsigned long) curpad, po));
+#else
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad swipe %d\n", po));
+#endif /* USE_THREADS */
SvPADTMP_off(curpad[po]);
curpad[po] = NEWSV(1107,0);
SvPADTMP_on(curpad[po]);
@@ -456,11 +490,17 @@ pad_swipe(PADOFFSET po)
void
pad_reset()
{
+ dTHR;
register I32 po;
if (AvARRAY(comppad) != curpad)
croak("panic: pad_reset curpad");
+#ifdef USE_THREADS
+ DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
+ (unsigned long) thr, (unsigned long) curpad));
+#else
DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad reset\n"));
+#endif /* USE_THREADS */
if (!tainting) { /* Can't mix tainted and non-tainted temporaries. */
for (po = AvMAX(comppad); po > padix_floor; po--) {
if (curpad[po] && !SvIMMORTAL(curpad[po]))
@@ -474,27 +514,27 @@ pad_reset()
/* Destructor */
void
-op_free(op)
-OP *op;
+op_free(o)
+OP *o;
{
register OP *kid, *nextkid;
- if (!op || op->op_seq == (U16)-1)
+ if (!o || o->op_seq == (U16)-1)
return;
- if (op->op_flags & OPf_KIDS) {
- for (kid = cUNOP->op_first; kid; kid = nextkid) {
+ if (o->op_flags & OPf_KIDS) {
+ for (kid = cUNOPo->op_first; kid; kid = nextkid) {
nextkid = kid->op_sibling; /* Get before next freeing kid */
op_free(kid);
}
}
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_NULL:
- op->op_targ = 0; /* Was holding old type, if any. */
+ o->op_targ = 0; /* Was holding old type, if any. */
break;
case OP_ENTEREVAL:
- op->op_targ = 0; /* Was holding hints. */
+ o->op_targ = 0; /* Was holding hints. */
break;
default:
if (!(op->op_flags & OPf_REF) || (check[op->op_type] != ck_ftst))
@@ -503,51 +543,51 @@ OP *op;
case OP_GVSV:
case OP_GV:
case OP_AELEMFAST:
- SvREFCNT_dec(cGVOP->op_gv);
+ SvREFCNT_dec(cGVOPo->op_gv);
break;
case OP_NEXTSTATE:
case OP_DBSTATE:
Safefree(cCOP->cop_label);
- SvREFCNT_dec(cCOP->cop_filegv);
+ SvREFCNT_dec(cCOPo->cop_filegv);
break;
case OP_CONST:
- SvREFCNT_dec(cSVOP->op_sv);
+ SvREFCNT_dec(cSVOPo->op_sv);
break;
case OP_GOTO:
case OP_NEXT:
case OP_LAST:
case OP_REDO:
- if (op->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
+ if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
break;
/* FALL THROUGH */
case OP_TRANS:
- Safefree(cPVOP->op_pv);
+ Safefree(cPVOPo->op_pv);
break;
case OP_SUBST:
- op_free(cPMOP->op_pmreplroot);
+ op_free(cPMOPo->op_pmreplroot);
/* FALL THROUGH */
case OP_PUSHRE:
case OP_MATCH:
- pregfree(cPMOP->op_pmregexp);
- SvREFCNT_dec(cPMOP->op_pmshort);
+ pregfree(cPMOPo->op_pmregexp);
+ SvREFCNT_dec(cPMOPo->op_pmshort);
break;
}
- if (op->op_targ > 0)
- pad_free(op->op_targ);
+ if (o->op_targ > 0)
+ pad_free(o->op_targ);
- Safefree(op);
+ Safefree(o);
}
static void
-null(op)
-OP* op;
+null(o)
+OP* o;
{
- if (op->op_type != OP_NULL && op->op_targ > 0)
- pad_free(op->op_targ);
- op->op_targ = op->op_type;
- op->op_type = OP_NULL;
- op->op_ppaddr = ppaddr[OP_NULL];
+ if (o->op_type != OP_NULL && o->op_targ > 0)
+ pad_free(o->op_targ);
+ o->op_targ = o->op_type;
+ o->op_type = OP_NULL;
+ o->op_ppaddr = ppaddr[OP_NULL];
}
/* Contextualizers */
@@ -555,48 +595,48 @@ OP* op;
#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
OP *
-linklist(op)
-OP *op;
+linklist(o)
+OP *o;
{
register OP *kid;
- if (op->op_next)
- return op->op_next;
+ if (o->op_next)
+ return o->op_next;
/* establish postfix order */
- if (cUNOP->op_first) {
- op->op_next = LINKLIST(cUNOP->op_first);
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+ if (cUNOPo->op_first) {
+ o->op_next = LINKLIST(cUNOPo->op_first);
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling)
kid->op_next = LINKLIST(kid->op_sibling);
else
- kid->op_next = op;
+ kid->op_next = o;
}
}
else
- op->op_next = op;
+ o->op_next = o;
- return op->op_next;
+ return o->op_next;
}
OP *
-scalarkids(op)
-OP *op;
+scalarkids(o)
+OP *o;
{
OP *kid;
- if (op && op->op_flags & OPf_KIDS) {
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ if (o && o->op_flags & OPf_KIDS) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
scalar(kid);
}
- return op;
+ return o;
}
static OP *
-scalarboolean(op)
-OP *op;
+scalarboolean(o)
+OP *o;
{
if (dowarn &&
- op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) {
+ o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
line_t oldline = curcop->cop_line;
if (copline != NOLINE)
@@ -604,36 +644,36 @@ OP *op;
warn("Found = in conditional, should be ==");
curcop->cop_line = oldline;
}
- return scalar(op);
+ return scalar(o);
}
OP *
-scalar(op)
-OP *op;
+scalar(o)
+OP *o;
{
OP *kid;
/* assumes no premature commitment */
- if (!op || (op->op_flags & OPf_WANT) || error_count
- || op->op_type == OP_RETURN)
- return op;
+ if (!o || (o->op_flags & OPf_WANT) || error_count
+ || o->op_type == OP_RETURN)
+ return o;
- op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
+ o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_REPEAT:
- if (op->op_private & OPpREPEAT_DOLIST)
- null(((LISTOP*)cBINOP->op_first)->op_first);
- scalar(cBINOP->op_first);
+ if (o->op_private & OPpREPEAT_DOLIST)
+ null(((LISTOP*)cBINOPo->op_first)->op_first);
+ scalar(cBINOPo->op_first);
break;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
- for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
scalar(kid);
break;
case OP_SPLIT:
- if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
+ if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
if (!kPMOP->op_pmreplroot)
deprecate("implicit split to @_");
}
@@ -642,14 +682,14 @@ OP *op;
case OP_SUBST:
case OP_NULL:
default:
- if (op->op_flags & OPf_KIDS) {
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
+ if (o->op_flags & OPf_KIDS) {
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
scalar(kid);
}
break;
case OP_LEAVE:
case OP_LEAVETRY:
- kid = cLISTOP->op_first;
+ kid = cLISTOPo->op_first;
scalar(kid);
while (kid = kid->op_sibling) {
if (kid->op_sibling)
@@ -662,7 +702,7 @@ OP *op;
case OP_SCOPE:
case OP_LINESEQ:
case OP_LIST:
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling)
scalarvoid(kid);
else
@@ -671,31 +711,31 @@ OP *op;
curcop = &compiling;
break;
}
- return op;
+ return o;
}
OP *
-scalarvoid(op)
-OP *op;
+scalarvoid(o)
+OP *o;
{
OP *kid;
char* useless = 0;
SV* sv;
/* assumes no premature commitment */
- if (!op || (op->op_flags & OPf_WANT) == OPf_WANT_LIST || error_count
- || op->op_type == OP_RETURN)
- return op;
+ if (!o || (o->op_flags & OPf_WANT) == OPf_WANT_LIST || error_count
+ || o->op_type == OP_RETURN)
+ return o;
- op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
+ o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
- switch (op->op_type) {
+ switch (o->op_type) {
default:
- if (!(opargs[op->op_type] & OA_FOLDCONST))
+ if (!(opargs[o->op_type] & OA_FOLDCONST))
break;
/* FALL THROUGH */
case OP_REPEAT:
- if (op->op_flags & OPf_STACKED)
+ if (o->op_flags & OPf_STACKED)
break;
/* FALL THROUGH */
case OP_GVSV:
@@ -766,26 +806,26 @@ OP *op;
case OP_GGRNAM:
case OP_GGRGID:
case OP_GETLOGIN:
- if (!(op->op_private & OPpLVAL_INTRO))
- useless = op_desc[op->op_type];
+ if (!(o->op_private & OPpLVAL_INTRO))
+ useless = op_desc[o->op_type];
break;
case OP_RV2GV:
case OP_RV2SV:
case OP_RV2AV:
case OP_RV2HV:
- if (!(op->op_private & OPpLVAL_INTRO) &&
- (!op->op_sibling || op->op_sibling->op_type != OP_READLINE))
+ if (!(o->op_private & OPpLVAL_INTRO) &&
+ (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
useless = "a variable";
break;
case OP_NEXTSTATE:
case OP_DBSTATE:
- curcop = ((COP*)op); /* for warning below */
+ curcop = ((COP*)o); /* for warning below */
break;
case OP_CONST:
- sv = cSVOP->op_sv;
+ sv = cSVOPo->op_sv;
if (dowarn) {
useless = "a constant";
if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
@@ -797,37 +837,37 @@ OP *op;
useless = 0;
}
}
- null(op); /* don't execute a constant */
+ null(o); /* don't execute a constant */
SvREFCNT_dec(sv); /* don't even remember it */
break;
case OP_POSTINC:
- op->op_type = OP_PREINC; /* pre-increment is faster */
- op->op_ppaddr = ppaddr[OP_PREINC];
+ o->op_type = OP_PREINC; /* pre-increment is faster */
+ o->op_ppaddr = ppaddr[OP_PREINC];
break;
case OP_POSTDEC:
- op->op_type = OP_PREDEC; /* pre-decrement is faster */
- op->op_ppaddr = ppaddr[OP_PREDEC];
+ o->op_type = OP_PREDEC; /* pre-decrement is faster */
+ o->op_ppaddr = ppaddr[OP_PREDEC];
break;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
- for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
scalarvoid(kid);
break;
case OP_NULL:
- if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE)
- curcop = ((COP*)op); /* for warning below */
- if (op->op_flags & OPf_STACKED)
+ if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
+ curcop = ((COP*)o); /* for warning below */
+ if (o->op_flags & OPf_STACKED)
break;
/* FALL THROUGH */
case OP_ENTERTRY:
case OP_ENTER:
case OP_SCALAR:
- if (!(op->op_flags & OPf_KIDS))
+ if (!(o->op_flags & OPf_KIDS))
break;
/* FALL THROUGH */
case OP_SCOPE:
@@ -836,7 +876,7 @@ OP *op;
case OP_LEAVELOOP:
case OP_LINESEQ:
case OP_LIST:
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
scalarvoid(kid);
break;
case OP_ENTEREVAL:
@@ -847,7 +887,7 @@ OP *op;
op->op_flags &= ~OPf_WANT;
return scalar(op);
case OP_SPLIT:
- if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
+ if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
if (!kPMOP->op_pmreplroot)
deprecate("implicit split to @_");
}
@@ -855,61 +895,61 @@ OP *op;
}
if (useless && dowarn)
warn("Useless use of %s in void context", useless);
- return op;
+ return o;
}
OP *
-listkids(op)
-OP *op;
+listkids(o)
+OP *o;
{
OP *kid;
- if (op && op->op_flags & OPf_KIDS) {
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ if (o && o->op_flags & OPf_KIDS) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
list(kid);
}
- return op;
+ return o;
}
OP *
-list(op)
-OP *op;
+list(o)
+OP *o;
{
OP *kid;
/* assumes no premature commitment */
- if (!op || (op->op_flags & OPf_WANT) || error_count
- || op->op_type == OP_RETURN)
- return op;
+ if (!o || (o->op_flags & OPf_WANT) || error_count
+ || o->op_type == OP_RETURN)
+ return o;
- op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
+ o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_FLOP:
case OP_REPEAT:
- list(cBINOP->op_first);
+ list(cBINOPo->op_first);
break;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
- for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
list(kid);
break;
default:
case OP_MATCH:
case OP_SUBST:
case OP_NULL:
- if (!(op->op_flags & OPf_KIDS))
+ if (!(o->op_flags & OPf_KIDS))
break;
- if (!op->op_next && cUNOP->op_first->op_type == OP_FLOP) {
- list(cBINOP->op_first);
- return gen_constant_list(op);
+ if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) {
+ list(cBINOPo->op_first);
+ return gen_constant_list(o);
}
case OP_LIST:
- listkids(op);
+ listkids(o);
break;
case OP_LEAVE:
case OP_LEAVETRY:
- kid = cLISTOP->op_first;
+ kid = cLISTOPo->op_first;
list(kid);
while (kid = kid->op_sibling) {
if (kid->op_sibling)
@@ -921,7 +961,7 @@ OP *op;
break;
case OP_SCOPE:
case OP_LINESEQ:
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling)
scalarvoid(kid);
else
@@ -934,68 +974,69 @@ OP *op;
op->op_flags &= ~OPf_WANT;
return scalar(op);
}
- return op;
+ return o;
}
OP *
-scalarseq(op)
-OP *op;
+scalarseq(o)
+OP *o;
{
OP *kid;
- if (op) {
- if (op->op_type == OP_LINESEQ ||
- op->op_type == OP_SCOPE ||
- op->op_type == OP_LEAVE ||
- op->op_type == OP_LEAVETRY)
+ if (o) {
+ if (o->op_type == OP_LINESEQ ||
+ o->op_type == OP_SCOPE ||
+ o->op_type == OP_LEAVE ||
+ o->op_type == OP_LEAVETRY)
{
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling) {
scalarvoid(kid);
}
}
curcop = &compiling;
}
- op->op_flags &= ~OPf_PARENS;
+ o->op_flags &= ~OPf_PARENS;
if (hints & HINT_BLOCK_SCOPE)
- op->op_flags |= OPf_PARENS;
+ o->op_flags |= OPf_PARENS;
}
else
- op = newOP(OP_STUB, 0);
- return op;
+ o = newOP(OP_STUB, 0);
+ return o;
}
static OP *
-modkids(op, type)
-OP *op;
+modkids(o, type)
+OP *o;
I32 type;
{
OP *kid;
- if (op && op->op_flags & OPf_KIDS) {
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ if (o && o->op_flags & OPf_KIDS) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
mod(kid, type);
}
- return op;
+ return o;
}
static I32 modcount;
OP *
-mod(op, type)
-OP *op;
+mod(o, type)
+OP *o;
I32 type;
{
+ dTHR;
OP *kid;
SV *sv;
- if (!op || error_count)
- return op;
+ if (!o || error_count)
+ return o;
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_UNDEF:
- return op;
+ return o;
case OP_CONST:
- if (!(op->op_private & (OPpCONST_ARYBASE)))
+ if (!(o->op_private & (OPpCONST_ARYBASE)))
goto nomod;
if (eval_start && eval_start->op_type == OP_CONST) {
compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv);
@@ -1016,11 +1057,11 @@ I32 type;
goto nomod;
case OP_ENTERSUB:
if ((type == OP_UNDEF || type == OP_REFGEN) &&
- !(op->op_flags & OPf_STACKED)) {
- op->op_type = OP_RV2CV; /* entersub => rv2cv */
- op->op_ppaddr = ppaddr[OP_RV2CV];
- assert(cUNOP->op_first->op_type == OP_NULL);
- null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
+ !(o->op_flags & OPf_STACKED)) {
+ o->op_type = OP_RV2CV; /* entersub => rv2cv */
+ o->op_ppaddr = ppaddr[OP_RV2CV];
+ assert(cUNOPo->op_first->op_type == OP_NULL);
+ null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
break;
}
/* FALL THROUGH */
@@ -1030,9 +1071,9 @@ I32 type;
if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
break;
yyerror(form("Can't modify %s in %s",
- op_desc[op->op_type],
+ op_desc[o->op_type],
type ? op_desc[type] : "local"));
- return op;
+ return o;
case OP_PREINC:
case OP_PREDEC:
@@ -1054,27 +1095,27 @@ I32 type;
case OP_I_MODULO:
case OP_I_ADD:
case OP_I_SUBTRACT:
- if (!(op->op_flags & OPf_STACKED))
+ if (!(o->op_flags & OPf_STACKED))
goto nomod;
modcount++;
break;
case OP_COND_EXPR:
- for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
mod(kid, type);
break;
case OP_RV2AV:
case OP_RV2HV:
- if (type == OP_REFGEN && op->op_flags & OPf_PARENS) {
+ if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
modcount = 10000;
- return op; /* Treat \(@foo) like ordinary list. */
+ return o; /* Treat \(@foo) like ordinary list. */
}
/* FALL THROUGH */
case OP_RV2GV:
- if (scalar_mod_type(op, type))
+ if (scalar_mod_type(o, type))
goto nomod;
- ref(cUNOP->op_first, op->op_type);
+ ref(cUNOPo->op_first, o->op_type);
/* FALL THROUGH */
case OP_AASSIGN:
case OP_ASLICE:
@@ -1086,9 +1127,9 @@ I32 type;
modcount = 10000;
break;
case OP_RV2SV:
- if (!type && cUNOP->op_first->op_type != OP_GV)
+ if (!type && cUNOPo->op_first->op_type != OP_GV)
croak("Can't localize a reference");
- ref(cUNOP->op_first, op->op_type);
+ ref(cUNOPo->op_first, o->op_type);
/* FALL THROUGH */
case OP_GV:
case OP_AV2ARYLEN:
@@ -1109,7 +1150,7 @@ I32 type;
modcount++;
if (!type)
croak("Can't localize lexical variable %s",
- SvPV(*av_fetch(comppad_name, op->op_targ, 4), na));
+ SvPV(*av_fetch(comppad_name, o->op_targ, 4), na));
break;
case OP_PUSHMARK:
@@ -1122,53 +1163,53 @@ I32 type;
case OP_POS:
case OP_VEC:
case OP_SUBSTR:
- pad_free(op->op_targ);
- op->op_targ = pad_alloc(op->op_type, SVs_PADMY);
- assert(SvTYPE(PAD_SV(op->op_targ)) == SVt_NULL);
- if (op->op_flags & OPf_KIDS)
- mod(cBINOP->op_first->op_sibling, type);
+ pad_free(o->op_targ);
+ o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
+ assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL);
+ if (o->op_flags & OPf_KIDS)
+ mod(cBINOPo->op_first->op_sibling, type);
break;
case OP_AELEM:
case OP_HELEM:
- ref(cBINOP->op_first, op->op_type);
+ ref(cBINOPo->op_first, o->op_type);
if (type == OP_ENTERSUB &&
- !(op->op_private & (OPpLVAL_INTRO | OPpDEREF)))
- op->op_private |= OPpLVAL_DEFER;
+ !(o->op_private & (OPpLVAL_INTRO | OPpDEREF)))
+ o->op_private |= OPpLVAL_DEFER;
modcount++;
break;
case OP_SCOPE:
case OP_LEAVE:
case OP_ENTER:
- if (op->op_flags & OPf_KIDS)
- mod(cLISTOP->op_last, type);
+ if (o->op_flags & OPf_KIDS)
+ mod(cLISTOPo->op_last, type);
break;
case OP_NULL:
- if (!(op->op_flags & OPf_KIDS))
+ if (!(o->op_flags & OPf_KIDS))
break;
- if (op->op_targ != OP_LIST) {
- mod(cBINOP->op_first, type);
+ if (o->op_targ != OP_LIST) {
+ mod(cBINOPo->op_first, type);
break;
}
/* FALL THROUGH */
case OP_LIST:
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
mod(kid, type);
break;
}
- op->op_flags |= OPf_MOD;
+ o->op_flags |= OPf_MOD;
if (type == OP_AASSIGN || type == OP_SASSIGN)
- op->op_flags |= OPf_SPECIAL|OPf_REF;
+ o->op_flags |= OPf_SPECIAL|OPf_REF;
else if (!type) {
- op->op_private |= OPpLVAL_INTRO;
- op->op_flags &= ~OPf_SPECIAL;
+ o->op_private |= OPpLVAL_INTRO;
+ o->op_flags &= ~OPf_SPECIAL;
}
else if (type != OP_GREPSTART && type != OP_ENTERSUB)
- op->op_flags |= OPf_REF;
- return op;
+ o->op_flags |= OPf_REF;
+ return o;
}
static bool
@@ -1218,83 +1259,83 @@ I32 type;
}
OP *
-refkids(op, type)
-OP *op;
+refkids(o, type)
+OP *o;
I32 type;
{
OP *kid;
- if (op && op->op_flags & OPf_KIDS) {
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ if (o && o->op_flags & OPf_KIDS) {
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
ref(kid, type);
}
- return op;
+ return o;
}
OP *
-ref(op, type)
-OP *op;
+ref(o, type)
+OP *o;
I32 type;
{
OP *kid;
- if (!op || error_count)
- return op;
+ if (!o || error_count)
+ return o;
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_ENTERSUB:
if ((type == OP_DEFINED) &&
- !(op->op_flags & OPf_STACKED)) {
- op->op_type = OP_RV2CV; /* entersub => rv2cv */
- op->op_ppaddr = ppaddr[OP_RV2CV];
- assert(cUNOP->op_first->op_type == OP_NULL);
- null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
- op->op_flags |= OPf_SPECIAL;
+ !(o->op_flags & OPf_STACKED)) {
+ o->op_type = OP_RV2CV; /* entersub => rv2cv */
+ o->op_ppaddr = ppaddr[OP_RV2CV];
+ assert(cUNOPo->op_first->op_type == OP_NULL);
+ null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */
+ o->op_flags |= OPf_SPECIAL;
}
break;
case OP_COND_EXPR:
- for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
ref(kid, type);
break;
case OP_RV2SV:
- ref(cUNOP->op_first, op->op_type);
+ ref(cUNOPo->op_first, o->op_type);
/* FALL THROUGH */
case OP_PADSV:
if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
- op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
- : type == OP_RV2HV ? OPpDEREF_HV
- : OPpDEREF_SV);
- op->op_flags |= OPf_MOD;
+ o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
+ : type == OP_RV2HV ? OPpDEREF_HV
+ : OPpDEREF_SV);
+ o->op_flags |= OPf_MOD;
}
break;
case OP_RV2AV:
case OP_RV2HV:
- op->op_flags |= OPf_REF;
+ o->op_flags |= OPf_REF;
/* FALL THROUGH */
case OP_RV2GV:
- ref(cUNOP->op_first, op->op_type);
+ ref(cUNOPo->op_first, o->op_type);
break;
case OP_PADAV:
case OP_PADHV:
- op->op_flags |= OPf_REF;
+ o->op_flags |= OPf_REF;
break;
case OP_SCALAR:
case OP_NULL:
- if (!(op->op_flags & OPf_KIDS))
+ if (!(o->op_flags & OPf_KIDS))
break;
- ref(cBINOP->op_first, type);
+ ref(cBINOPo->op_first, type);
break;
case OP_AELEM:
case OP_HELEM:
- ref(cBINOP->op_first, op->op_type);
+ ref(cBINOPo->op_first, o->op_type);
if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
- op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
- : type == OP_RV2HV ? OPpDEREF_HV
- : OPpDEREF_SV);
- op->op_flags |= OPf_MOD;
+ o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
+ : type == OP_RV2HV ? OPpDEREF_HV
+ : OPpDEREF_SV);
+ o->op_flags |= OPf_MOD;
}
break;
@@ -1302,30 +1343,30 @@ I32 type;
case OP_LEAVE:
case OP_ENTER:
case OP_LIST:
- if (!(op->op_flags & OPf_KIDS))
+ if (!(o->op_flags & OPf_KIDS))
break;
- ref(cLISTOP->op_last, type);
+ ref(cLISTOPo->op_last, type);
break;
default:
break;
}
- return scalar(op);
+ return scalar(o);
}
OP *
-my(op)
-OP *op;
+my(o)
+OP *o;
{
OP *kid;
I32 type;
- if (!op || error_count)
- return op;
+ if (!o || error_count)
+ return o;
- type = op->op_type;
+ type = o->op_type;
if (type == OP_LIST) {
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
my(kid);
}
else if (type != OP_PADSV &&
@@ -1333,12 +1374,12 @@ OP *op;
type != OP_PADHV &&
type != OP_PUSHMARK)
{
- yyerror(form("Can't declare %s in my", op_desc[op->op_type]));
- return op;
+ yyerror(form("Can't declare %s in my", op_desc[o->op_type]));
+ return o;
}
- op->op_flags |= OPf_MOD;
- op->op_private |= OPpLVAL_INTRO;
- return op;
+ o->op_flags |= OPf_MOD;
+ o->op_private |= OPpLVAL_INTRO;
+ return o;
}
OP *
@@ -1356,7 +1397,7 @@ I32 type;
OP *left;
OP *right;
{
- OP *op;
+ OP *o;
if (dowarn &&
(left->op_type == OP_RV2AV ||
@@ -1379,12 +1420,12 @@ OP *right;
if (right->op_type != OP_MATCH)
left = mod(left, right->op_type);
if (right->op_type == OP_TRANS)
- op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
+ o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
else
- op = prepend_elem(right->op_type, scalar(left), right);
+ o = prepend_elem(right->op_type, scalar(left), right);
if (type == OP_NOT)
- return newUNOP(OP_NOT, 0, scalar(op));
- return op;
+ return newUNOP(OP_NOT, 0, scalar(o));
+ return o;
}
else
return bind_match(type, left,
@@ -1392,13 +1433,13 @@ OP *right;
}
OP *
-invert(op)
-OP *op;
+invert(o)
+OP *o;
{
- if (!op)
- return op;
+ if (!o)
+ return o;
/* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */
- return newUNOP(OP_NOT, OPf_SPECIAL, scalar(op));
+ return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
}
OP *
@@ -1433,6 +1474,7 @@ int
block_start(full)
int full;
{
+ dTHR;
int retval = savestack_ix;
SAVEI32(comppad_name_floor);
if (full) {
@@ -1458,6 +1500,7 @@ block_end(floor, seq)
I32 floor;
OP* seq;
{
+ dTHR;
int needblockscope = hints & HINT_BLOCK_SCOPE;
OP* retval = scalarseq(seq);
LEAVE_SCOPE(floor);
@@ -1470,19 +1513,20 @@ OP* seq;
}
void
-newPROG(op)
-OP *op;
+newPROG(o)
+OP *o;
{
+ dTHR;
if (in_eval) {
- eval_root = newUNOP(OP_LEAVEEVAL, ((in_eval & 4) ? OPf_SPECIAL : 0), op);
+ eval_root = newUNOP(OP_LEAVEEVAL, ((in_eval & 4) ? OPf_SPECIAL : 0), o);
eval_start = linklist(eval_root);
eval_root->op_next = 0;
peep(eval_start);
}
else {
- if (!op)
+ if (!o)
return;
- main_root = scope(sawparens(scalarvoid(op)));
+ main_root = scope(sawparens(scalarvoid(o)));
curcop = &compiling;
main_start = LINKLIST(main_root);
main_root->op_next = 0;
@@ -1544,6 +1588,7 @@ OP *
fold_constants(o)
register OP *o;
{
+ dTHR;
register OP *curop;
I32 type = o->op_type;
SV *sv;
@@ -1627,6 +1672,7 @@ OP *
gen_constant_list(o)
register OP *o;
{
+ dTHR;
register OP *curop;
I32 oldtmps_floor = tmps_floor;
@@ -1636,10 +1682,10 @@ register OP *o;
op = curop = LINKLIST(o);
o->op_next = 0;
- pp_pushmark();
+ pp_pushmark(ARGS);
runops();
op = curop;
- pp_anonlist();
+ pp_anonlist(ARGS);
tmps_floor = oldtmps_floor;
o->op_type = OP_RV2AV;
@@ -1652,38 +1698,38 @@ register OP *o;
}
OP *
-convert(type, flags, op)
+convert(type, flags, o)
I32 type;
I32 flags;
-OP* op;
+OP* o;
{
OP *kid;
OP *last = 0;
- if (!op || op->op_type != OP_LIST)
- op = newLISTOP(OP_LIST, 0, op, Nullop);
+ if (!o || o->op_type != OP_LIST)
+ o = newLISTOP(OP_LIST, 0, o, Nullop);
else
- op->op_flags &= ~OPf_WANT;
+ o->op_flags &= ~OPf_WANT;
if (!(opargs[type] & OA_MARK))
- null(cLISTOP->op_first);
+ null(cLISTOPo->op_first);
- op->op_type = type;
- op->op_ppaddr = ppaddr[type];
- op->op_flags |= flags;
+ o->op_type = type;
+ o->op_ppaddr = ppaddr[type];
+ o->op_flags |= flags;
- op = CHECKOP(type, op);
- if (op->op_type != type)
- return op;
+ o = CHECKOP(type, o);
+ if (o->op_type != type)
+ return o;
- if (cLISTOP->op_children < 7) {
+ if (cLISTOPo->op_children < 7) {
/* XXX do we really need to do this if we're done appending?? */
- for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
last = kid;
- cLISTOP->op_last = last; /* in case check substituted last arg */
+ cLISTOPo->op_last = last; /* in case check substituted last arg */
}
- return fold_constants(op);
+ return fold_constants(o);
}
/* List constructors */
@@ -1783,13 +1829,13 @@ newNULLLIST()
}
OP *
-force_list(op)
-OP* op;
+force_list(o)
+OP *o;
{
- if (!op || op->op_type != OP_LIST)
- op = newLISTOP(OP_LIST, 0, op, Nullop);
- null(op);
- return op;
+ if (!o || o->op_type != OP_LIST)
+ o = newLISTOP(OP_LIST, 0, o, Nullop);
+ null(o);
+ return o;
}
OP *
@@ -1836,19 +1882,19 @@ newOP(type, flags)
I32 type;
I32 flags;
{
- OP *op;
- Newz(1101, op, 1, OP);
- op->op_type = type;
- op->op_ppaddr = ppaddr[type];
- op->op_flags = flags;
+ OP *o;
+ Newz(1101, o, 1, OP);
+ o->op_type = type;
+ o->op_ppaddr = ppaddr[type];
+ o->op_flags = flags;
- op->op_next = op;
- op->op_private = 0 + (flags >> 8);
+ o->op_next = o;
+ o->op_private = 0 + (flags >> 8);
if (opargs[type] & OA_RETSCALAR)
- scalar(op);
+ scalar(o);
if (opargs[type] & OA_TARGET)
- op->op_targ = pad_alloc(type, SVs_PADTMP);
- return CHECKOP(type, op);
+ o->op_targ = pad_alloc(type, SVs_PADTMP);
+ return CHECKOP(type, o);
}
OP *
@@ -1914,8 +1960,8 @@ OP* last;
}
OP *
-pmtrans(op, expr, repl)
-OP *op;
+pmtrans(o, expr, repl)
+OP *o;
OP *expr;
OP *repl;
{
@@ -1931,10 +1977,10 @@ OP *repl;
I32 complement;
register short *tbl;
- tbl = (short*)cPVOP->op_pv;
- complement = op->op_private & OPpTRANS_COMPLEMENT;
- delete = op->op_private & OPpTRANS_DELETE;
- /* squash = op->op_private & OPpTRANS_SQUASH; */
+ tbl = (short*)cPVOPo->op_pv;
+ complement = o->op_private & OPpTRANS_COMPLEMENT;
+ delete = o->op_private & OPpTRANS_DELETE;
+ /* squash = o->op_private & OPpTRANS_SQUASH; */
if (complement) {
Zero(tbl, 256, short);
@@ -1977,7 +2023,7 @@ OP *repl;
op_free(expr);
op_free(repl);
- return op;
+ return o;
}
OP *
@@ -1985,6 +2031,7 @@ newPMOP(type, flags)
I32 type;
I32 flags;
{
+ dTHR;
PMOP *pmop;
Newz(1101, pmop, 1, PMOP);
@@ -2006,24 +2053,24 @@ I32 flags;
}
OP *
-pmruntime(op, expr, repl)
-OP *op;
+pmruntime(o, expr, repl)
+OP *o;
OP *expr;
OP *repl;
{
PMOP *pm;
LOGOP *rcop;
- if (op->op_type == OP_TRANS)
- return pmtrans(op, expr, repl);
+ if (o->op_type == OP_TRANS)
+ return pmtrans(o, expr, repl);
- pm = (PMOP*)op;
+ pm = (PMOP*)o;
if (expr->op_type == OP_CONST) {
STRLEN plen;
SV *pat = ((SVOP*)expr)->op_sv;
char *p = SvPV(pat, plen);
- if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
+ if ((o->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
sv_setpvn(pat, "\\s+", 3);
p = SvPV(pat, plen);
pm->op_pmflags |= PMf_SKIPWHITE;
@@ -2044,7 +2091,7 @@ OP *repl;
rcop->op_first = scalar(expr);
rcop->op_flags |= OPf_KIDS;
rcop->op_private = 1;
- rcop->op_other = op;
+ rcop->op_other = o;
/* establish postfix order */
if (pm->op_pmflags & PMf_KEEP) {
@@ -2057,7 +2104,7 @@ OP *repl;
expr->op_next = (OP*)rcop;
}
- prepend_elem(op->op_type, scalar((OP*)rcop), op);
+ prepend_elem(o->op_type, scalar((OP*)rcop), o);
}
if (repl) {
@@ -2099,7 +2146,7 @@ OP *repl;
if (curop == repl) {
pm->op_pmflags |= PMf_CONST; /* const for long enough */
pm->op_pmpermflags |= PMf_CONST; /* const for long enough */
- prepend_elem(op->op_type, scalar(repl), op);
+ prepend_elem(o->op_type, scalar(repl), o);
}
else {
Newz(1101, rcop, 1, LOGOP);
@@ -2108,7 +2155,7 @@ OP *repl;
rcop->op_first = scalar(repl);
rcop->op_flags |= OPf_KIDS;
rcop->op_private = 1;
- rcop->op_other = op;
+ rcop->op_other = o;
/* establish postfix order */
rcop->op_next = LINKLIST(repl);
@@ -2149,6 +2196,7 @@ I32 type;
I32 flags;
GV *gv;
{
+ dTHR;
GVOP *gvop;
Newz(1101, gvop, 1, GVOP);
gvop->op_type = type;
@@ -2184,21 +2232,22 @@ char *pv;
}
void
-package(op)
-OP *op;
+package(o)
+OP *o;
{
+ dTHR;
SV *sv;
save_hptr(&curstash);
save_item(curstname);
- if (op) {
+ if (o) {
STRLEN len;
char *name;
- sv = cSVOP->op_sv;
+ sv = cSVOPo->op_sv;
name = SvPV(sv, len);
curstash = gv_stashpvn(name,len,TRUE);
sv_setpvn(curstname, name, len);
- op_free(op);
+ op_free(o);
}
else {
sv_setpv(curstname,"<none>");
@@ -2301,18 +2350,18 @@ OP *listval;
}
static I32
-list_assignment(op)
-register OP *op;
+list_assignment(o)
+register OP *o;
{
- if (!op)
+ if (!o)
return TRUE;
- if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS)
- op = cUNOP->op_first;
+ if (o->op_type == OP_NULL && o->op_flags & OPf_KIDS)
+ o = cUNOPo->op_first;
- if (op->op_type == OP_COND_EXPR) {
- I32 t = list_assignment(cCONDOP->op_first->op_sibling);
- I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling);
+ if (o->op_type == OP_COND_EXPR) {
+ I32 t = list_assignment(cCONDOPo->op_first->op_sibling);
+ I32 f = list_assignment(cCONDOPo->op_first->op_sibling->op_sibling);
if (t && f)
return TRUE;
@@ -2321,15 +2370,15 @@ register OP *op;
return FALSE;
}
- if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS ||
- op->op_type == OP_RV2AV || op->op_type == OP_RV2HV ||
- op->op_type == OP_ASLICE || op->op_type == OP_HSLICE)
+ if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS ||
+ o->op_type == OP_RV2AV || o->op_type == OP_RV2HV ||
+ o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
return TRUE;
- if (op->op_type == OP_PADAV || op->op_type == OP_PADHV)
+ if (o->op_type == OP_PADAV || o->op_type == OP_PADHV)
return TRUE;
- if (op->op_type == OP_RV2SV)
+ if (o->op_type == OP_RV2SV)
return FALSE;
return FALSE;
@@ -2342,7 +2391,7 @@ OP *left;
I32 optype;
OP *right;
{
- OP *op;
+ OP *o;
if (optype) {
if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
@@ -2367,16 +2416,16 @@ OP *right;
op_free(right);
return Nullop;
}
- op = newBINOP(OP_AASSIGN, flags,
+ o = newBINOP(OP_AASSIGN, flags,
list(force_list(right)),
list(force_list(left)) );
- op->op_private = 0 | (flags >> 8);
+ o->op_private = 0 | (flags >> 8);
if (!(left->op_private & OPpLVAL_INTRO)) {
static int generation = 100;
OP *curop;
- OP *lastop = op;
+ OP *lastop = o;
generation++;
- for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) {
+ for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
if (opargs[curop->op_type] & OA_DANGEROUS) {
if (curop->op_type == OP_GV) {
GV *gv = ((GVOP*)curop)->op_gv;
@@ -2408,8 +2457,8 @@ OP *right;
}
lastop = curop;
}
- if (curop != op)
- op->op_private = OPpASSIGN_COMMON;
+ if (curop != o)
+ o->op_private = OPpASSIGN_COMMON;
}
if (right && right->op_type == OP_SPLIT) {
OP* tmpop;
@@ -2419,17 +2468,17 @@ OP *right;
PMOP *pm = (PMOP*)tmpop;
if (left->op_type == OP_RV2AV &&
!(left->op_private & OPpLVAL_INTRO) &&
- !(op->op_private & OPpASSIGN_COMMON) )
+ !(o->op_private & OPpASSIGN_COMMON) )
{
tmpop = ((UNOP*)left)->op_first;
if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
pm->op_pmflags |= PMf_ONCE;
- tmpop = ((UNOP*)op)->op_first; /* to list (nulled) */
+ tmpop = cUNOPo->op_first; /* to list (nulled) */
tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
tmpop->op_sibling = Nullop; /* don't free split */
right->op_next = tmpop->op_next; /* fix starting loc */
- op_free(op); /* blow off assign */
+ op_free(o); /* blow off assign */
right->op_flags &= ~OPf_WANT;
/* "I don't know and I don't care." */
return right;
@@ -2446,7 +2495,7 @@ OP *right;
}
}
}
- return op;
+ return o;
}
if (!right)
right = newOP(OP_UNDEF, 0);
@@ -2456,24 +2505,25 @@ OP *right;
}
else {
eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
- op = newBINOP(OP_SASSIGN, flags,
+ o = newBINOP(OP_SASSIGN, flags,
scalar(right), mod(scalar(left), OP_SASSIGN) );
if (eval_start)
eval_start = 0;
else {
- op_free(op);
+ op_free(o);
return Nullop;
}
}
- return op;
+ return o;
}
OP *
-newSTATEOP(flags, label, op)
+newSTATEOP(flags, label, o)
I32 flags;
char *label;
-OP *op;
+OP *o;
{
+ dTHR;
U32 seq = intro_my();
register COP *cop;
@@ -2518,7 +2568,7 @@ OP *op;
}
}
- return prepend_elem(OP_LINESEQ, (OP*)cop, op);
+ return prepend_elem(OP_LINESEQ, (OP*)cop, o);
}
/* "Introduce" my variables to visible status. */
@@ -2551,8 +2601,9 @@ I32 flags;
OP* first;
OP* other;
{
+ dTHR;
LOGOP *logop;
- OP *op;
+ OP *o;
if (type == OP_XOR) /* Not short circuit, but here by precedence. */
return newBINOP(type, flags, scalar(first), scalar(other));
@@ -2565,12 +2616,12 @@ OP* other;
type = OP_OR;
else
type = OP_AND;
- op = first;
- first = cUNOP->op_first;
- if (op->op_next)
- first->op_next = op->op_next;
- cUNOP->op_first = Nullop;
- op_free(op);
+ o = first;
+ first = cUNOPo->op_first;
+ if (o->op_next)
+ first->op_next = o->op_next;
+ cUNOPo->op_first = Nullop;
+ op_free(o);
}
}
if (first->op_type == OP_CONST) {
@@ -2642,10 +2693,10 @@ OP* other;
first->op_next = (OP*)logop;
first->op_sibling = other;
- op = newUNOP(OP_NULL, 0, (OP*)logop);
- other->op_next = op;
+ o = newUNOP(OP_NULL, 0, (OP*)logop);
+ other->op_next = o;
- return op;
+ return o;
}
OP *
@@ -2655,8 +2706,9 @@ OP* first;
OP* trueop;
OP* falseop;
{
+ dTHR;
CONDOP *condop;
- OP *op;
+ OP *o;
if (!falseop)
return newLOGOP(OP_AND, 0, first, trueop);
@@ -2696,12 +2748,12 @@ OP* falseop;
first->op_sibling = trueop;
trueop->op_sibling = falseop;
- op = newUNOP(OP_NULL, 0, (OP*)condop);
+ o = newUNOP(OP_NULL, 0, (OP*)condop);
- trueop->op_next = op;
- falseop->op_next = op;
+ trueop->op_next = o;
+ falseop->op_next = o;
- return op;
+ return o;
}
OP *
@@ -2710,10 +2762,11 @@ I32 flags;
OP *left;
OP *right;
{
+ dTHR;
CONDOP *condop;
OP *flip;
OP *flop;
- OP *op;
+ OP *o;
Newz(1101, condop, 1, CONDOP);
@@ -2730,7 +2783,7 @@ OP *right;
condop->op_next = (OP*)condop;
flip = newUNOP(OP_FLIP, flags, (OP*)condop);
flop = newUNOP(OP_FLOP, 0, flip);
- op = newUNOP(OP_NULL, 0, flop);
+ o = newUNOP(OP_NULL, 0, flop);
linklist(flop);
left->op_next = flip;
@@ -2744,11 +2797,11 @@ OP *right;
flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
- flip->op_next = op;
+ flip->op_next = o;
if (!flip->op_private || !flop->op_private)
- linklist(op); /* blow off optimizer unless constant */
+ linklist(o); /* blow off optimizer unless constant */
- return op;
+ return o;
}
OP *
@@ -2758,8 +2811,9 @@ I32 debuggable;
OP *expr;
OP *block;
{
+ dTHR;
OP* listop;
- OP* op;
+ OP* o;
int once = block && block->op_flags & OPf_SPECIAL &&
(block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
@@ -2773,20 +2827,20 @@ OP *block;
}
listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
- op = newLOGOP(OP_AND, 0, expr, listop);
+ o = newLOGOP(OP_AND, 0, expr, listop);
- ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
+ ((LISTOP*)listop)->op_last->op_next = LINKLIST(o);
- if (once && op != listop)
- op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
+ if (once && o != listop)
+ o->op_next = ((LOGOP*)cUNOPo->op_first)->op_other;
- if (op == listop)
- op = newUNOP(OP_NULL, 0, op); /* or do {} while 1 loses outer block */
+ if (o == listop)
+ o = newUNOP(OP_NULL, 0, o); /* or do {} while 1 loses outer block */
- op->op_flags |= flags;
- op = scope(op);
- op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
- return op;
+ o->op_flags |= flags;
+ o = scope(o);
+ o->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
+ return o;
}
OP *
@@ -2798,10 +2852,11 @@ OP *expr;
OP *block;
OP *cont;
{
+ dTHR;
OP *redo;
OP *next = 0;
OP *listop;
- OP *op;
+ OP *o;
OP *condop;
if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
@@ -2821,19 +2876,19 @@ OP *cont;
redo = LINKLIST(listop);
if (expr) {
- op = newLOGOP(OP_AND, 0, expr, scalar(listop));
- if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) {
+ o = newLOGOP(OP_AND, 0, expr, scalar(listop));
+ if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
op_free(expr); /* oops, it's a while (0) */
op_free((OP*)loop);
return Nullop; /* (listop already freed by newLOGOP) */
}
((LISTOP*)listop)->op_last->op_next = condop =
- (op == listop ? redo : LINKLIST(op));
+ (o == listop ? redo : LINKLIST(o));
if (!next)
next = condop;
}
else
- op = listop;
+ o = listop;
if (!loop) {
Newz(1101,loop,1,LOOP);
@@ -2843,19 +2898,19 @@ OP *cont;
loop->op_next = (OP*)loop;
}
- op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op);
+ o = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, o);
loop->op_redoop = redo;
- loop->op_lastop = op;
+ loop->op_lastop = o;
if (next)
loop->op_nextop = next;
else
- loop->op_nextop = op;
+ loop->op_nextop = o;
- op->op_flags |= flags;
- op->op_private |= (flags >> 8);
- return op;
+ o->op_flags |= flags;
+ o->op_private |= (flags >> 8);
+ return o;
}
OP *
@@ -2912,9 +2967,10 @@ newLOOPEX(type, label)
I32 type;
OP* label;
{
- OP *op;
+ dTHR;
+ OP *o;
if (type != OP_GOTO || label->op_type == OP_CONST) {
- op = newPVOP(type, 0, savepv(
+ o = newPVOP(type, 0, savepv(
label->op_type == OP_CONST
? SvPVx(((SVOP*)label)->op_sv, na)
: "" ));
@@ -2923,19 +2979,34 @@ OP* label;
else {
if (label->op_type == OP_ENTERSUB)
label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
- op = newUNOP(type, OPf_STACKED, label);
+ o = newUNOP(type, OPf_STACKED, label);
}
hints |= HINT_BLOCK_SCOPE;
- return op;
+ return o;
}
void
cv_undef(cv)
CV *cv;
{
+ dTHR;
+#ifdef USE_THREADS
+ MUTEX_DESTROY(CvMUTEXP(cv));
+ Safefree(CvMUTEXP(cv));
+ if (CvCONDP(cv)) {
+ COND_DESTROY(CvCONDP(cv));
+ Safefree(CvCONDP(cv));
+ }
+#endif /* USE_THREADS */
+
if (!CvXSUB(cv) && CvROOT(cv)) {
+#ifdef USE_THREADS
+ if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
+ croak("Can't undef active subroutine");
+#else
if (CvDEPTH(cv))
croak("Can't undef active subroutine");
+#endif /* USE_THREADS */
ENTER;
SAVESPTR(curpad);
@@ -3026,6 +3097,7 @@ cv_clone2(proto, outside)
CV* proto;
CV* outside;
{
+ dTHR;
AV* av;
I32 ix;
AV* protopadlist = CvPADLIST(proto);
@@ -3052,6 +3124,13 @@ CV* outside;
if (CvANON(proto))
CvANON_on(cv);
+#ifdef USE_THREADS
+ New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
+ MUTEX_INIT(CvMUTEXP(cv));
+ New(666, CvCONDP(cv), 1, pthread_cond_t);
+ COND_INIT(CvCONDP(cv));
+ CvOWNER(cv) = 0;
+#endif /* USE_THREADS */
CvFILEGV(cv) = CvFILEGV(proto);
CvGV(cv) = (GV*)SvREFCNT_inc(CvGV(proto));
CvSTASH(cv) = CvSTASH(proto);
@@ -3203,7 +3282,7 @@ CV* cv;
if (sv)
return Nullsv;
if (type == OP_CONST)
- sv = ((SVOP*)o)->op_sv;
+ sv = cSVOPo->op_sv;
else if (type == OP_PADSV) {
AV* pad = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
sv = pad ? AvARRAY(pad)[o->op_targ] : Nullsv;
@@ -3219,20 +3298,21 @@ CV* cv;
}
CV *
-newSUB(floor,op,proto,block)
+newSUB(floor,o,proto,block)
I32 floor;
-OP *op;
+OP *o;
OP *proto;
OP *block;
{
- char *name = op ? SvPVx(cSVOP->op_sv, na) : Nullch;
+ dTHR;
+ char *name = o ? SvPVx(cSVOPo->op_sv, na) : Nullch;
GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch;
register CV *cv;
I32 ix;
- if (op)
- SAVEFREEOP(op);
+ if (o)
+ SAVEFREEOP(o);
if (proto)
SAVEFREEOP(proto);
@@ -3285,6 +3365,13 @@ OP *block;
CvGV(cv) = (GV*)SvREFCNT_inc(gv);
CvFILEGV(cv) = curcop->cop_filegv;
CvSTASH(cv) = curstash;
+#ifdef USE_THREADS
+ CvOWNER(cv) = 0;
+ New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
+ MUTEX_INIT(CvMUTEXP(cv));
+ New(666, CvCONDP(cv), 1, pthread_cond_t);
+ COND_INIT(CvCONDP(cv));
+#endif /* USE_THREADS */
if (ps)
sv_setpv((SV*)cv, ps);
@@ -3451,6 +3538,7 @@ char *name;
void (*subaddr) _((CV*));
char *filename;
{
+ dTHR;
GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
register CV *cv;
@@ -3484,7 +3572,14 @@ char *filename;
sub_generation++;
}
}
- CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+ CvGV(cv) = SvREFCNT_inc(gv);
+#ifdef USE_THREADS
+ New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
+ MUTEX_INIT(CvMUTEXP(cv));
+ New(666, CvCONDP(cv), 1, pthread_cond_t);
+ COND_INIT(CvCONDP(cv));
+ CvOWNER(cv) = 0;
+#endif /* USE_THREADS */
CvFILEGV(cv) = gv_fetchfile(filename);
CvXSUB(cv) = subaddr;
@@ -3520,18 +3615,19 @@ char *filename;
}
void
-newFORM(floor,op,block)
+newFORM(floor,o,block)
I32 floor;
-OP *op;
+OP *o;
OP *block;
{
+ dTHR;
register CV *cv;
char *name;
GV *gv;
I32 ix;
- if (op)
- name = SvPVx(cSVOP->op_sv, na);
+ if (o)
+ name = SvPVx(cSVOPo->op_sv, na);
else
name = "STDOUT";
gv = gv_fetchpv(name,TRUE, SVt_PVFM);
@@ -3560,25 +3656,25 @@ OP *block;
CvSTART(cv) = LINKLIST(CvROOT(cv));
CvROOT(cv)->op_next = 0;
peep(CvSTART(cv));
- op_free(op);
+ op_free(o);
copline = NOLINE;
LEAVE_SCOPE(floor);
}
OP *
-newANONLIST(op)
-OP* op;
+newANONLIST(o)
+OP* o;
{
return newUNOP(OP_REFGEN, 0,
- mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
+ mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
}
OP *
-newANONHASH(op)
-OP* op;
+newANONHASH(o)
+OP* o;
{
return newUNOP(OP_REFGEN, 0,
- mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
+ mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
}
OP *
@@ -3705,8 +3801,8 @@ OP *o;
/* Check routines. */
OP *
-ck_anoncode(op)
-OP *op;
+ck_anoncode(o)
+OP *o;
{
PADOFFSET ix;
SV* name;
@@ -3716,42 +3812,42 @@ OP *op;
sv_setpvn(name, "&", 1);
SvIVX(name) = -1;
SvNVX(name) = 1;
- ix = pad_alloc(op->op_type, SVs_PADMY);
+ ix = pad_alloc(o->op_type, SVs_PADMY);
av_store(comppad_name, ix, name);
- av_store(comppad, ix, cSVOP->op_sv);
- SvPADMY_on(cSVOP->op_sv);
- cSVOP->op_sv = Nullsv;
- cSVOP->op_targ = ix;
- return op;
+ av_store(comppad, ix, cSVOPo->op_sv);
+ SvPADMY_on(cSVOPo->op_sv);
+ cSVOPo->op_sv = Nullsv;
+ cSVOPo->op_targ = ix;
+ return o;
}
OP *
-ck_bitop(op)
-OP *op;
+ck_bitop(o)
+OP *o;
{
- op->op_private = hints;
- return op;
+ o->op_private = hints;
+ return o;
}
OP *
-ck_concat(op)
-OP *op;
+ck_concat(o)
+OP *o;
{
- if (cUNOP->op_first->op_type == OP_CONCAT)
- op->op_flags |= OPf_STACKED;
- return op;
+ if (cUNOPo->op_first->op_type == OP_CONCAT)
+ o->op_flags |= OPf_STACKED;
+ return o;
}
OP *
-ck_spair(op)
-OP *op;
+ck_spair(o)
+OP *o;
{
- if (op->op_flags & OPf_KIDS) {
+ if (o->op_flags & OPf_KIDS) {
OP* newop;
OP* kid;
- OPCODE type = op->op_type;
- op = modkids(ck_fun(op), type);
- kid = cUNOP->op_first;
+ OPCODE type = o->op_type;
+ o = modkids(ck_fun(o), type);
+ kid = cUNOPo->op_first;
newop = kUNOP->op_first->op_sibling;
if (newop &&
(newop->op_sibling ||
@@ -3759,68 +3855,68 @@ OP *op;
newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
- return op;
+ return o;
}
op_free(kUNOP->op_first);
kUNOP->op_first = newop;
}
- op->op_ppaddr = ppaddr[++op->op_type];
- return ck_fun(op);
+ o->op_ppaddr = ppaddr[++o->op_type];
+ return ck_fun(o);
}
OP *
-ck_delete(op)
-OP *op;
+ck_delete(o)
+OP *o;
{
- op = ck_fun(op);
- op->op_private = 0;
- if (op->op_flags & OPf_KIDS) {
- OP *kid = cUNOP->op_first;
+ o = ck_fun(o);
+ o->op_private = 0;
+ if (o->op_flags & OPf_KIDS) {
+ OP *kid = cUNOPo->op_first;
if (kid->op_type == OP_HSLICE)
- op->op_private |= OPpSLICE;
+ o->op_private |= OPpSLICE;
else if (kid->op_type != OP_HELEM)
croak("%s argument is not a HASH element or slice",
- op_desc[op->op_type]);
+ op_desc[o->op_type]);
null(kid);
}
- return op;
+ return o;
}
OP *
-ck_eof(op)
-OP *op;
+ck_eof(o)
+OP *o;
{
- I32 type = op->op_type;
+ I32 type = o->op_type;
- if (op->op_flags & OPf_KIDS) {
- if (cLISTOP->op_first->op_type == OP_STUB) {
- op_free(op);
- op = newUNOP(type, OPf_SPECIAL,
+ if (o->op_flags & OPf_KIDS) {
+ if (cLISTOPo->op_first->op_type == OP_STUB) {
+ op_free(o);
+ o = newUNOP(type, OPf_SPECIAL,
newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
}
- return ck_fun(op);
+ return ck_fun(o);
}
- return op;
+ return o;
}
OP *
-ck_eval(op)
-OP *op;
+ck_eval(o)
+OP *o;
{
hints |= HINT_BLOCK_SCOPE;
- if (op->op_flags & OPf_KIDS) {
- SVOP *kid = (SVOP*)cUNOP->op_first;
+ if (o->op_flags & OPf_KIDS) {
+ SVOP *kid = (SVOP*)cUNOPo->op_first;
if (!kid) {
- op->op_flags &= ~OPf_KIDS;
- null(op);
+ o->op_flags &= ~OPf_KIDS;
+ null(o);
}
else if (kid->op_type == OP_LINESEQ) {
LOGOP *enter;
- kid->op_next = op->op_next;
- cUNOP->op_first = 0;
- op_free(op);
+ kid->op_next = o->op_next;
+ cUNOPo->op_first = 0;
+ op_free(o);
Newz(1101, enter, 1, LOGOP);
enter->op_type = OP_ENTERTRY;
@@ -3830,35 +3926,35 @@ OP *op;
/* establish postfix order */
enter->op_next = (OP*)enter;
- op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
- op->op_type = OP_LEAVETRY;
- op->op_ppaddr = ppaddr[OP_LEAVETRY];
- enter->op_other = op;
- return op;
+ o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
+ o->op_type = OP_LEAVETRY;
+ o->op_ppaddr = ppaddr[OP_LEAVETRY];
+ enter->op_other = o;
+ return o;
}
}
else {
- op_free(op);
- op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ op_free(o);
+ o = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
}
- op->op_targ = (PADOFFSET)hints;
- return op;
+ o->op_targ = (PADOFFSET)hints;
+ return o;
}
OP *
-ck_exec(op)
-OP *op;
+ck_exec(o)
+OP *o;
{
OP *kid;
- if (op->op_flags & OPf_STACKED) {
- op = ck_fun(op);
- kid = cUNOP->op_first->op_sibling;
+ if (o->op_flags & OPf_STACKED) {
+ o = ck_fun(o);
+ kid = cUNOPo->op_first->op_sibling;
if (kid->op_type == OP_RV2GV)
null(kid);
}
else
- op = listkids(op);
- return op;
+ o = listkids(o);
+ return o;
}
OP *
@@ -3886,12 +3982,13 @@ register OP *o;
}
OP *
-ck_rvconst(op)
-register OP *op;
+ck_rvconst(o)
+register OP *o;
{
- SVOP *kid = (SVOP*)cUNOP->op_first;
+ dTHR;
+ SVOP *kid = (SVOP*)cUNOPo->op_first;
- op->op_private |= (hints & HINT_STRICT_REFS);
+ o->op_private |= (hints & HINT_STRICT_REFS);
if (kid->op_type == OP_CONST) {
char *name;
int iscv;
@@ -3900,7 +3997,7 @@ register OP *op;
name = SvPV(kid->op_sv, na);
if ((hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
char *badthing = Nullch;
- switch (op->op_type) {
+ switch (o->op_type) {
case OP_RV2SV:
badthing = "a SCALAR";
break;
@@ -3931,71 +4028,73 @@ register OP *op;
iscv | !(kid->op_private & OPpCONST_ENTERED),
iscv
? SVt_PVCV
- : op->op_type == OP_RV2SV
+ : o->op_type == OP_RV2SV
? SVt_PV
- : op->op_type == OP_RV2AV
+ : o->op_type == OP_RV2AV
? SVt_PVAV
- : op->op_type == OP_RV2HV
+ : o->op_type == OP_RV2HV
? SVt_PVHV
: SVt_PVGV);
}
SvREFCNT_dec(kid->op_sv);
kid->op_sv = SvREFCNT_inc(gv);
}
- return op;
+ return o;
}
OP *
-ck_ftst(op)
-OP *op;
+ck_ftst(o)
+OP *o;
{
- I32 type = op->op_type;
+ dTHR;
+ I32 type = o->op_type;
- if (op->op_flags & OPf_REF)
- return op;
+ if (o->op_flags & OPf_REF)
+ return o;
- if (op->op_flags & OPf_KIDS) {
- SVOP *kid = (SVOP*)cUNOP->op_first;
+ if (o->op_flags & OPf_KIDS) {
+ SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
OP *newop = newGVOP(type, OPf_REF,
gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
- op_free(op);
+ op_free(o);
return newop;
}
}
else {
- op_free(op);
+ op_free(o);
if (type == OP_FTTTY)
return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
SVt_PVIO));
else
return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
}
- return op;
+ return o;
}
OP *
-ck_fun(op)
-OP *op;
+ck_fun(o)
+OP *o;
{
+ dTHR;
register OP *kid;
OP **tokid;
OP *sibl;
I32 numargs = 0;
- int type = op->op_type;
+ int type = o->op_type;
register I32 oa = opargs[type] >> OASHIFT;
- if (op->op_flags & OPf_STACKED) {
+ if (o->op_flags & OPf_STACKED) {
if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
oa &= ~OA_OPTIONAL;
else
- return no_fh_allowed(op);
+ return no_fh_allowed(o);
}
- if (op->op_flags & OPf_KIDS) {
- tokid = &cLISTOP->op_first;
- kid = cLISTOP->op_first;
+ if (o->op_flags & OPf_KIDS) {
+ tokid = &cLISTOPo->op_first;
+ kid = cLISTOPo->op_first;
if (kid->op_type == OP_PUSHMARK ||
kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
{
@@ -4035,7 +4134,7 @@ OP *op;
*tokid = kid;
}
else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
- bad_type(numargs, "array", op_desc[op->op_type], kid);
+ bad_type(numargs, "array", op_desc[o->op_type], kid);
mod(kid, type);
break;
case OA_HVREF:
@@ -4053,7 +4152,7 @@ OP *op;
*tokid = kid;
}
else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
- bad_type(numargs, "hash", op_desc[op->op_type], kid);
+ bad_type(numargs, "hash", op_desc[o->op_type], kid);
mod(kid, type);
break;
case OA_CVREF:
@@ -4094,13 +4193,13 @@ OP *op;
tokid = &kid->op_sibling;
kid = kid->op_sibling;
}
- op->op_private |= numargs;
+ o->op_private |= numargs;
if (kid)
- return too_many_arguments(op,op_desc[op->op_type]);
- listkids(op);
+ return too_many_arguments(o,op_desc[o->op_type]);
+ listkids(o);
}
else if (opargs[type] & OA_DEFGV) {
- op_free(op);
+ op_free(o);
return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
}
@@ -4108,14 +4207,14 @@ OP *op;
while (oa & OA_OPTIONAL)
oa >>= 4;
if (oa && oa != OA_LIST)
- return too_few_arguments(op,op_desc[op->op_type]);
+ return too_few_arguments(o,op_desc[o->op_type]);
}
- return op;
+ return o;
}
OP *
-ck_glob(op)
-OP *op;
+ck_glob(o)
+OP *o;
{
GV *gv = gv_fetchpv("glob", FALSE, SVt_PVCV);
@@ -4138,57 +4237,57 @@ OP *op;
append_elem(OP_GLOB, op, newSVREF(newGVOP(OP_GV, 0, defgv)));
gv = newGVgen("main");
gv_IOadd(gv);
- append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
- scalarkids(op);
- return ck_fun(op);
+ append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
+ scalarkids(o);
+ return ck_fun(o);
}
OP *
-ck_grep(op)
-OP *op;
+ck_grep(o)
+OP *o;
{
LOGOP *gwop;
OP *kid;
- OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
+ OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
- op->op_ppaddr = ppaddr[OP_GREPSTART];
+ o->op_ppaddr = ppaddr[OP_GREPSTART];
Newz(1101, gwop, 1, LOGOP);
- if (op->op_flags & OPf_STACKED) {
+ if (o->op_flags & OPf_STACKED) {
OP* k;
- op = ck_sort(op);
- kid = cLISTOP->op_first->op_sibling;
- for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
+ o = ck_sort(o);
+ kid = cLISTOPo->op_first->op_sibling;
+ for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) {
kid = k;
}
kid->op_next = (OP*)gwop;
- op->op_flags &= ~OPf_STACKED;
+ o->op_flags &= ~OPf_STACKED;
}
- kid = cLISTOP->op_first->op_sibling;
+ kid = cLISTOPo->op_first->op_sibling;
if (type == OP_MAPWHILE)
list(kid);
else
scalar(kid);
- op = ck_fun(op);
+ o = ck_fun(o);
if (error_count)
- return op;
- kid = cLISTOP->op_first->op_sibling;
+ return o;
+ kid = cLISTOPo->op_first->op_sibling;
if (kid->op_type != OP_NULL)
croak("panic: ck_grep");
kid = kUNOP->op_first;
gwop->op_type = type;
gwop->op_ppaddr = ppaddr[type];
- gwop->op_first = listkids(op);
+ gwop->op_first = listkids(o);
gwop->op_flags |= OPf_KIDS;
gwop->op_private = 1;
gwop->op_other = LINKLIST(kid);
gwop->op_targ = pad_alloc(type, SVs_PADTMP);
kid->op_next = (OP*)gwop;
- kid = cLISTOP->op_first->op_sibling;
+ kid = cLISTOPo->op_first->op_sibling;
if (!kid || !kid->op_sibling)
- return too_few_arguments(op,op_desc[op->op_type]);
+ return too_few_arguments(o,op_desc[o->op_type]);
for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
mod(kid, OP_GREPSTART);
@@ -4196,142 +4295,142 @@ OP *op;
}
OP *
-ck_index(op)
-OP *op;
+ck_index(o)
+OP *o;
{
- if (op->op_flags & OPf_KIDS) {
- OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ if (o->op_flags & OPf_KIDS) {
+ OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
if (kid && kid->op_type == OP_CONST)
fbm_compile(((SVOP*)kid)->op_sv);
}
- return ck_fun(op);
+ return ck_fun(o);
}
OP *
-ck_lengthconst(op)
-OP *op;
+ck_lengthconst(o)
+OP *o;
{
/* XXX length optimization goes here */
- return ck_fun(op);
+ return ck_fun(o);
}
OP *
-ck_lfun(op)
-OP *op;
+ck_lfun(o)
+OP *o;
{
- OPCODE type = op->op_type;
- return modkids(ck_fun(op), type);
+ OPCODE type = o->op_type;
+ return modkids(ck_fun(o), type);
}
OP *
-ck_rfun(op)
-OP *op;
+ck_rfun(o)
+OP *o;
{
- OPCODE type = op->op_type;
- return refkids(ck_fun(op), type);
+ OPCODE type = o->op_type;
+ return refkids(ck_fun(o), type);
}
OP *
-ck_listiob(op)
-OP *op;
+ck_listiob(o)
+OP *o;
{
register OP *kid;
- kid = cLISTOP->op_first;
+ kid = cLISTOPo->op_first;
if (!kid) {
- op = force_list(op);
- kid = cLISTOP->op_first;
+ o = force_list(o);
+ kid = cLISTOPo->op_first;
}
if (kid->op_type == OP_PUSHMARK)
kid = kid->op_sibling;
- if (kid && op->op_flags & OPf_STACKED)
+ if (kid && o->op_flags & OPf_STACKED)
kid = kid->op_sibling;
else if (kid && !kid->op_sibling) { /* print HANDLE; */
if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
- op->op_flags |= OPf_STACKED; /* make it a filehandle */
+ o->op_flags |= OPf_STACKED; /* make it a filehandle */
kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
- cLISTOP->op_first->op_sibling = kid;
- cLISTOP->op_last = kid;
+ cLISTOPo->op_first->op_sibling = kid;
+ cLISTOPo->op_last = kid;
kid = kid->op_sibling;
}
}
if (!kid)
- append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+ append_elem(o->op_type, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
- op = listkids(op);
+ o = listkids(o);
- op->op_private = 0;
+ o->op_private = 0;
#ifdef USE_LOCALE
if (hints & HINT_LOCALE)
- op->op_private |= OPpLOCALE;
+ o->op_private |= OPpLOCALE;
#endif
- return op;
+ return o;
}
OP *
-ck_fun_locale(op)
-OP *op;
+ck_fun_locale(o)
+OP *o;
{
- op = ck_fun(op);
+ o = ck_fun(o);
- op->op_private = 0;
+ o->op_private = 0;
#ifdef USE_LOCALE
if (hints & HINT_LOCALE)
- op->op_private |= OPpLOCALE;
+ o->op_private |= OPpLOCALE;
#endif
- return op;
+ return o;
}
OP *
-ck_scmp(op)
-OP *op;
+ck_scmp(o)
+OP *o;
{
- op->op_private = 0;
+ o->op_private = 0;
#ifdef USE_LOCALE
if (hints & HINT_LOCALE)
- op->op_private |= OPpLOCALE;
+ o->op_private |= OPpLOCALE;
#endif
- return op;
+ return o;
}
OP *
-ck_match(op)
-OP *op;
+ck_match(o)
+OP *o;
{
- op->op_private |= OPpRUNTIME;
- return op;
+ o->op_private |= OPpRUNTIME;
+ return o;
}
OP *
-ck_null(op)
-OP *op;
+ck_null(o)
+OP *o;
{
- return op;
+ return o;
}
OP *
-ck_repeat(op)
-OP *op;
+ck_repeat(o)
+OP *o;
{
- if (cBINOP->op_first->op_flags & OPf_PARENS) {
- op->op_private |= OPpREPEAT_DOLIST;
- cBINOP->op_first = force_list(cBINOP->op_first);
+ if (cBINOPo->op_first->op_flags & OPf_PARENS) {
+ o->op_private |= OPpREPEAT_DOLIST;
+ cBINOPo->op_first = force_list(cBINOPo->op_first);
}
else
- scalar(op);
- return op;
+ scalar(o);
+ return o;
}
OP *
-ck_require(op)
-OP *op;
+ck_require(o)
+OP *o;
{
- if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
- SVOP *kid = (SVOP*)cUNOP->op_first;
+ if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
+ SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
char *s;
@@ -4345,68 +4444,68 @@ OP *op;
sv_catpvn(kid->op_sv, ".pm", 3);
}
}
- return ck_fun(op);
+ return ck_fun(o);
}
OP *
-ck_retarget(op)
-OP *op;
+ck_retarget(o)
+OP *o;
{
croak("NOT IMPL LINE %d",__LINE__);
/* STUB */
- return op;
+ return o;
}
OP *
-ck_select(op)
-OP *op;
+ck_select(o)
+OP *o;
{
OP* kid;
- if (op->op_flags & OPf_KIDS) {
- kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ if (o->op_flags & OPf_KIDS) {
+ kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
if (kid && kid->op_sibling) {
- op->op_type = OP_SSELECT;
- op->op_ppaddr = ppaddr[OP_SSELECT];
- op = ck_fun(op);
- return fold_constants(op);
+ o->op_type = OP_SSELECT;
+ o->op_ppaddr = ppaddr[OP_SSELECT];
+ o = ck_fun(o);
+ return fold_constants(o);
}
}
- op = ck_fun(op);
- kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ o = ck_fun(o);
+ kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
if (kid && kid->op_type == OP_RV2GV)
kid->op_private &= ~HINT_STRICT_REFS;
- return op;
+ return o;
}
OP *
-ck_shift(op)
-OP *op;
+ck_shift(o)
+OP *o;
{
- I32 type = op->op_type;
+ I32 type = o->op_type;
- if (!(op->op_flags & OPf_KIDS)) {
- op_free(op);
+ if (!(o->op_flags & OPf_KIDS)) {
+ op_free(o);
return newUNOP(type, 0,
scalar(newUNOP(OP_RV2AV, 0,
scalar(newGVOP(OP_GV, 0, subline
? defgv
: gv_fetchpv("ARGV", TRUE, SVt_PVAV) )))));
}
- return scalar(modkids(ck_fun(op), type));
+ return scalar(modkids(ck_fun(o), type));
}
OP *
-ck_sort(op)
-OP *op;
+ck_sort(o)
+OP *o;
{
- op->op_private = 0;
+ o->op_private = 0;
#ifdef USE_LOCALE
if (hints & HINT_LOCALE)
- op->op_private |= OPpLOCALE;
+ o->op_private |= OPpLOCALE;
#endif
- if (op->op_flags & OPf_STACKED) {
- OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ if (o->op_flags & OPf_STACKED) {
+ OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
OP *k;
kid = kUNOP->op_first; /* get past rv2gv */
@@ -4417,7 +4516,7 @@ OP *op;
kid->op_next = 0;
}
else if (kid->op_type == OP_LEAVE) {
- if (op->op_type == OP_SORT) {
+ if (o->op_type == OP_SORT) {
null(kid); /* wipe out leave */
kid->op_next = kid;
@@ -4432,47 +4531,47 @@ OP *op;
}
peep(k);
- kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
null(kid); /* wipe out rv2gv */
- if (op->op_type == OP_SORT)
+ if (o->op_type == OP_SORT)
kid->op_next = kid;
else
kid->op_next = k;
- op->op_flags |= OPf_SPECIAL;
+ o->op_flags |= OPf_SPECIAL;
}
}
- return op;
+ return o;
}
OP *
-ck_split(op)
-OP *op;
+ck_split(o)
+OP *o;
{
register OP *kid;
PMOP* pm;
- if (op->op_flags & OPf_STACKED)
- return no_fh_allowed(op);
+ if (o->op_flags & OPf_STACKED)
+ return no_fh_allowed(o);
- kid = cLISTOP->op_first;
+ kid = cLISTOPo->op_first;
if (kid->op_type != OP_NULL)
croak("panic: ck_split");
kid = kid->op_sibling;
- op_free(cLISTOP->op_first);
- cLISTOP->op_first = kid;
+ op_free(cLISTOPo->op_first);
+ cLISTOPo->op_first = kid;
if (!kid) {
- cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
- cLISTOP->op_last = kid; /* There was only one element previously */
+ cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
+ cLISTOPo->op_last = kid; /* There was only one element previously */
}
if (kid->op_type != OP_MATCH) {
OP *sibl = kid->op_sibling;
kid->op_sibling = 0;
kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
- if (cLISTOP->op_first == cLISTOP->op_last)
- cLISTOP->op_last = kid;
- cLISTOP->op_first = kid;
+ if (cLISTOPo->op_first == cLISTOPo->op_last)
+ cLISTOPo->op_last = kid;
+ cLISTOPo->op_first = kid;
kid->op_sibling = sibl;
}
pm = (PMOP*)kid;
@@ -4486,30 +4585,31 @@ OP *op;
scalar(kid);
if (!kid->op_sibling)
- append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+ append_elem(OP_SPLIT, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
kid = kid->op_sibling;
scalar(kid);
if (!kid->op_sibling)
- append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
+ append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
kid = kid->op_sibling;
scalar(kid);
if (kid->op_sibling)
- return too_many_arguments(op,op_desc[op->op_type]);
+ return too_many_arguments(o,op_desc[o->op_type]);
- return op;
+ return o;
}
OP *
-ck_subr(op)
-OP *op;
+ck_subr(o)
+OP *o;
{
- OP *prev = ((cUNOP->op_first->op_sibling)
- ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first;
- OP *o = prev->op_sibling;
+ dTHR;
+ OP *prev = ((cUNOPo->op_first->op_sibling)
+ ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
+ OP *o2 = prev->op_sibling;
OP *cvop;
char *proto = 0;
CV *cv = 0;
@@ -4517,28 +4617,28 @@ OP *op;
int optional = 0;
I32 arg = 0;
- for (cvop = o; cvop->op_sibling; cvop = cvop->op_sibling) ;
+ for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
if (cvop->op_type == OP_RV2CV) {
SVOP* tmpop;
- op->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
+ o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
null(cvop); /* disable rv2cv */
tmpop = (SVOP*)((UNOP*)cvop)->op_first;
if (tmpop->op_type == OP_GV) {
cv = GvCVu(tmpop->op_sv);
- if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER)) {
+ if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
proto = SvPV((SV*)cv, na);
}
}
}
- op->op_private |= (hints & HINT_STRICT_REFS);
+ o->op_private |= (hints & HINT_STRICT_REFS);
if (perldb && curstash != debstash)
- op->op_private |= OPpENTERSUB_DB;
- while (o != cvop) {
+ o->op_private |= OPpENTERSUB_DB;
+ while (o2 != cvop) {
if (proto) {
switch (*proto) {
case '\0':
- return too_many_arguments(op, gv_ename(namegv));
+ return too_many_arguments(o, gv_ename(namegv));
case ';':
optional = 1;
proto++;
@@ -4546,28 +4646,28 @@ OP *op;
case '$':
proto++;
arg++;
- scalar(o);
+ scalar(o2);
break;
case '%':
case '@':
- list(o);
+ list(o2);
arg++;
break;
case '&':
proto++;
arg++;
- if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF)
- bad_type(arg, "block", gv_ename(namegv), o);
+ if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
+ bad_type(arg, "block", gv_ename(namegv), o2);
break;
case '*':
proto++;
arg++;
- if (o->op_type == OP_RV2GV)
+ if (o2->op_type == OP_RV2GV)
goto wrapref;
{
- OP* kid = o;
- o = newUNOP(OP_RV2GV, 0, kid);
- o->op_sibling = kid->op_sibling;
+ OP* kid = o2;
+ o2 = newUNOP(OP_RV2GV, 0, kid);
+ o2->op_sibling = kid->op_sibling;
kid->op_sibling = 0;
prev->op_sibling = o;
}
@@ -4577,29 +4677,29 @@ OP *op;
arg++;
switch (*proto++) {
case '*':
- if (o->op_type != OP_RV2GV)
- bad_type(arg, "symbol", gv_ename(namegv), o);
+ if (o2->op_type != OP_RV2GV)
+ bad_type(arg, "symbol", gv_ename(namegv), o2);
goto wrapref;
case '&':
- if (o->op_type != OP_RV2CV)
- bad_type(arg, "sub", gv_ename(namegv), o);
+ if (o2->op_type != OP_RV2CV)
+ bad_type(arg, "sub", gv_ename(namegv), o2);
goto wrapref;
case '$':
- if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV)
- bad_type(arg, "scalar", gv_ename(namegv), o);
+ if (o2->op_type != OP_RV2SV && o2->op_type != OP_PADSV)
+ bad_type(arg, "scalar", gv_ename(namegv), o2);
goto wrapref;
case '@':
- if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV)
- bad_type(arg, "array", gv_ename(namegv), o);
+ if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
+ bad_type(arg, "array", gv_ename(namegv), o2);
goto wrapref;
case '%':
- if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV)
- bad_type(arg, "hash", gv_ename(namegv), o);
+ if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
+ bad_type(arg, "hash", gv_ename(namegv), o2);
wrapref:
{
- OP* kid = o;
- o = newUNOP(OP_REFGEN, 0, kid);
- o->op_sibling = kid->op_sibling;
+ OP* kid = o2;
+ o2 = newUNOP(OP_REFGEN, 0, kid);
+ o2->op_sibling = kid->op_sibling;
kid->op_sibling = 0;
prev->op_sibling = o;
}
@@ -4617,38 +4717,38 @@ OP *op;
}
}
else
- list(o);
- mod(o, OP_ENTERSUB);
- prev = o;
- o = o->op_sibling;
+ list(o2);
+ mod(o2, OP_ENTERSUB);
+ prev = o2;
+ o2 = o2->op_sibling;
}
if (proto && !optional && *proto == '$')
- return too_few_arguments(op, gv_ename(namegv));
- return op;
+ return too_few_arguments(o, gv_ename(namegv));
+ return o;
}
OP *
-ck_svconst(op)
-OP *op;
+ck_svconst(o)
+OP *o;
{
- SvREADONLY_on(cSVOP->op_sv);
- return op;
+ SvREADONLY_on(cSVOPo->op_sv);
+ return o;
}
OP *
-ck_trunc(op)
-OP *op;
+ck_trunc(o)
+OP *o;
{
- if (op->op_flags & OPf_KIDS) {
- SVOP *kid = (SVOP*)cUNOP->op_first;
+ if (o->op_flags & OPf_KIDS) {
+ SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_NULL)
kid = (SVOP*)kid->op_sibling;
if (kid &&
kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
- op->op_flags |= OPf_SPECIAL;
+ o->op_flags |= OPf_SPECIAL;
}
- return ck_fun(op);
+ return ck_fun(o);
}
/* A peephole optimizer. We visit the ops in the order they're to execute. */
@@ -4657,6 +4757,7 @@ void
peep(o)
register OP* o;
{
+ dTHR;
register OP* oldop = 0;
if (!o || o->op_seq)
return;
diff --git a/op.h b/op.h
index d58f825bee..f9dad977ef 100644
--- a/op.h
+++ b/op.h
@@ -24,6 +24,7 @@
*/
typedef U32 PADOFFSET;
+#define NOT_IN_PAD ((PADOFFSET) -1)
#ifdef DEBUGGING_OPS
#define OPCODE opcode
@@ -233,6 +234,19 @@ struct loop {
#define cCOP ((COP*)op)
#define cLOOP ((LOOP*)op)
+#define cUNOPo ((UNOP*)o)
+#define cBINOPo ((BINOP*)o)
+#define cLISTOPo ((LISTOP*)o)
+#define cLOGOPo ((LOGOP*)o)
+#define cCONDOPo ((CONDOP*)o)
+#define cPMOPo ((PMOP*)o)
+#define cSVOPo ((SVOP*)o)
+#define cGVOPo ((GVOP*)o)
+#define cPVOPo ((PVOP*)o)
+#define cCVOPo ((CVOP*)o)
+#define cCOPo ((COP*)o)
+#define cLOOPo ((LOOP*)o)
+
#define kUNOP ((UNOP*)kid)
#define kBINOP ((BINOP*)kid)
#define kLISTOP ((LISTOP*)kid)
diff --git a/opcode.pl b/opcode.pl
index 158b70e95d..7e8f6ac37c 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -82,13 +82,13 @@ END
# Emit function declarations.
for (sort keys %ckname) {
- print "OP *\t", &tab(3,$_),"_((OP* op));\n";
+ print "OP *\t", &tab(3,$_),"_((OP* o));\n";
}
print "\n";
for (@ops) {
- print "OP *\t", &tab(3, "pp_\L$_"), "_((void));\n";
+ print "OP *\t", &tab(3, "pp_\L$_"), "_((ARGSproto));\n";
}
# Emit ppcode switch array.
diff --git a/perl.c b/perl.c
index fd99e75040..e7600df2d1 100644
--- a/perl.c
+++ b/perl.c
@@ -72,10 +72,12 @@ static void init_main_stash _((void));
static void init_perllib _((void));
static void init_postdump_symbols _((int, char **, char **));
static void init_predump_symbols _((void));
-static void init_stacks _((void));
static void my_exit_jump _((void)) __attribute__((noreturn));
static void nuke_stacks _((void));
static void open_script _((char *, bool, SV *));
+#ifdef USE_THREADS
+static void thread_destruct _((void *));
+#endif /* USE_THREADS */
static void usage _((char *));
static void validate_suid _((char *, char*));
@@ -95,6 +97,10 @@ void
perl_construct( sv_interp )
register PerlInterpreter *sv_interp;
{
+#ifdef USE_THREADS
+ struct thread *thr;
+#endif /* USE_THREADS */
+
if (!(curinterp = sv_interp))
return;
@@ -102,6 +108,21 @@ register PerlInterpreter *sv_interp;
Zero(sv_interp, 1, PerlInterpreter);
#endif
+#ifdef USE_THREADS
+#ifdef NEED_PTHREAD_INIT
+ pthread_init();
+#endif /* NEED_PTHREAD_INIT */
+ New(53, thr, 1, struct thread);
+ self = pthread_self();
+ if (pthread_key_create(&thr_key, thread_destruct))
+ croak("panic: pthread_key_create");
+ if (pthread_setspecific(thr_key, (void *) thr))
+ croak("panic: pthread_setspecific");
+ nthreads = 1;
+ cvcache = newHV();
+ thrflags = 0;
+#endif /* USE_THREADS */
+
/* Init the real globals? */
if (!linestr) {
linestr = NEWSV(65,80);
@@ -122,6 +143,12 @@ register PerlInterpreter *sv_interp;
nrs = newSVpv("\n", 1);
rs = SvREFCNT_inc(nrs);
+ MUTEX_INIT(&malloc_mutex);
+ MUTEX_INIT(&sv_mutex);
+ MUTEX_INIT(&eval_mutex);
+ MUTEX_INIT(&nthreads_mutex);
+ COND_INIT(&nthreads_cond);
+
pidstatus = newHV();
#ifdef MSDOS
@@ -169,14 +196,42 @@ register PerlInterpreter *sv_interp;
fdpid = newAV(); /* for remembering popen pids by fd */
- init_stacks();
+ init_stacks(ARGS);
+ DEBUG( {
+ New(51,debname,128,char);
+ New(52,debdelim,128,char);
+ } )
+
ENTER;
}
+#ifdef USE_THREADS
+void
+thread_destruct(arg)
+void *arg;
+{
+ struct thread *thr = (struct thread *) arg;
+ /*
+ * Decrement the global thread count and signal anyone listening.
+ * The only official thread listening is the original thread while
+ * in perl_destruct. It waits until it's the only thread and then
+ * performs END blocks and other process clean-ups.
+ */
+ DEBUG_L(fprintf(stderr, "thread_destruct: 0x%lx\n", (unsigned long) thr));
+
+ Safefree(thr);
+ MUTEX_LOCK(&nthreads_mutex);
+ nthreads--;
+ COND_BROADCAST(&nthreads_cond);
+ MUTEX_UNLOCK(&nthreads_mutex);
+}
+#endif /* USE_THREADS */
+
void
perl_destruct(sv_interp)
register PerlInterpreter *sv_interp;
{
+ dTHR;
int destruct_level; /* 0=none, 1=full, 2=full with checks */
I32 last_sv_count;
HV *hv;
@@ -184,6 +239,22 @@ register PerlInterpreter *sv_interp;
if (!(curinterp = sv_interp))
return;
+#ifdef USE_THREADS
+ /* Wait until all user-created threads go away */
+ MUTEX_LOCK(&nthreads_mutex);
+ while (nthreads > 1)
+ {
+ DEBUG_L(fprintf(stderr, "perl_destruct: waiting for %d threads\n",
+ nthreads - 1));
+ COND_WAIT(&nthreads_cond, &nthreads_mutex);
+ }
+ /* At this point, we're the last thread */
+ MUTEX_UNLOCK(&nthreads_mutex);
+ DEBUG_L(fprintf(stderr, "perl_destruct: armageddon has arrived\n"));
+ MUTEX_DESTROY(&nthreads_mutex);
+ COND_DESTROY(&nthreads_cond);
+#endif /* USE_THREADS */
+
destruct_level = perl_destruct_level;
#ifdef DEBUGGING
{
@@ -431,6 +502,11 @@ register PerlInterpreter *sv_interp;
hints = 0; /* Reset hints. Should hints be per-interpreter ? */
DEBUG_P(debprofdump());
+#ifdef USE_THREADS
+ MUTEX_DESTROY(&sv_mutex);
+ MUTEX_DESTROY(&malloc_mutex);
+ MUTEX_DESTROY(&eval_mutex);
+#endif /* USE_THREADS */
/* As the absolutely last thing, free the non-arena SV for mess() */
@@ -461,6 +537,7 @@ int argc;
char **argv;
char **env;
{
+ dTHR;
register SV *sv;
register char *s;
char *scriptname = NULL;
@@ -753,12 +830,22 @@ print \" \\@INC:\\n @INC\\n\";");
main_cv = 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();
av_push(comppad, Nullsv);
curpad = AvARRAY(comppad);
comppad_name = newAV();
comppad_name_fill = 0;
+#ifdef USE_THREADS
+ av_store(comppad_name, 0, newSVpv("@_", 2));
+#endif /* USE_THREADS */
min_intro_pending = 0;
padix = 0;
@@ -830,6 +917,7 @@ int
perl_run(sv_interp)
PerlInterpreter *sv_interp;
{
+ dTHR;
I32 oldscope;
dJMPENV;
int ret;
@@ -878,6 +966,10 @@ PerlInterpreter *sv_interp;
if (!restartop) {
DEBUG_x(dump_all());
DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
+#ifdef USE_THREADS
+ DEBUG_L(PerlIO_printf(Perl_debug_log, "main thread is 0x%lx\n",
+ (unsigned long) thr));
+#endif /* USE_THREADS */
if (minus_c) {
PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", origfilename);
@@ -968,6 +1060,7 @@ char *subname;
I32 flags; /* See G_* flags in cop.h */
register char **argv; /* null terminated arg list */
{
+ dTHR;
dSP;
PUSHMARK(sp);
@@ -994,13 +1087,14 @@ perl_call_method(methname, flags)
char *methname; /* name of the subroutine */
I32 flags; /* See G_* flags in cop.h */
{
+ dTHR;
dSP;
OP myop;
if (!op)
op = &myop;
XPUSHs(sv_2mortal(newSVpv(methname,0)));
PUTBACK;
- pp_method();
+ pp_method(ARGS);
return perl_call_sv(*stack_sp--, flags);
}
@@ -1010,6 +1104,7 @@ perl_call_sv(sv, flags)
SV* sv;
I32 flags; /* See G_* flags in cop.h */
{
+ dTHR;
LOGOP myop; /* fake syntax tree node */
SV** sp = stack_sp;
I32 oldmark;
@@ -1108,7 +1203,7 @@ I32 flags; /* See G_* flags in cop.h */
CATCH_SET(TRUE);
if (op == (OP*)&myop)
- op = pp_entersub();
+ op = pp_entersub(ARGS);
if (op)
runops();
retval = stack_sp - (stack_base + oldmark);
@@ -1151,6 +1246,7 @@ perl_eval_sv(sv, flags)
SV* sv;
I32 flags; /* See G_* flags in cop.h */
{
+ dTHR;
UNOP myop; /* fake syntax tree node */
SV** sp = stack_sp;
I32 oldmark = sp - stack_base;
@@ -1214,7 +1310,7 @@ I32 flags; /* See G_* flags in cop.h */
}
if (op == (OP*)&myop)
- op = pp_entereval();
+ op = pp_entereval(ARGS);
if (op)
runops();
retval = stack_sp - (stack_base + oldmark);
@@ -1432,30 +1528,31 @@ char *s;
forbid_setid("-m"); /* XXX ? */
if (*++s) {
char *start;
+ SV *sv;
char *use = "use ";
/* -M-foo == 'no foo' */
if (*s == '-') { use = "no "; ++s; }
- Sv = newSVpv(use,0);
+ sv = newSVpv(use,0);
start = s;
/* We allow -M'Module qw(Foo Bar)' */
while(isALNUM(*s) || *s==':') ++s;
if (*s != '=') {
- sv_catpv(Sv, start);
+ sv_catpv(sv, start);
if (*(start-1) == 'm') {
if (*s != '\0')
croak("Can't use '%c' after -mname", *s);
- sv_catpv( Sv, " ()");
+ sv_catpv( sv, " ()");
}
} else {
- sv_catpvn(Sv, start, s-start);
- sv_catpv(Sv, " split(/,/,q{");
- sv_catpv(Sv, ++s);
- sv_catpv(Sv, "})");
+ sv_catpvn(sv, start, s-start);
+ sv_catpv(sv, " split(/,/,q{");
+ sv_catpv(sv, ++s);
+ sv_catpv(sv, "})");
}
s += strlen(s);
if (preambleav == NULL)
preambleav = newAV();
- av_push(preambleav, Sv);
+ av_push(preambleav, sv);
}
else
croak("No space allowed after -%c", *(s-1));
@@ -1575,6 +1672,7 @@ my_unexec()
static void
init_main_stash()
{
+ dTHR;
GV *gv;
/* Note that strtab is a rather special HV. Assumptions are made
@@ -2147,6 +2245,7 @@ char *s;
static void
init_debugger()
{
+ dTHR;
curstash = debstash;
dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
AvREAL_off(dbargs);
@@ -2162,8 +2261,9 @@ init_debugger()
curstash = defstash;
}
-static void
-init_stacks()
+void
+init_stacks(ARGS)
+dARGS
{
curstack = newAV();
mainstack = curstack; /* remember in case we switch stacks */
@@ -2182,11 +2282,6 @@ init_stacks()
tmps_ix = -1;
tmps_max = 128;
- DEBUG( {
- New(51,debname,128,char);
- New(52,debdelim,128,char);
- } )
-
/*
* The following stacks almost certainly should be per-interpreter,
* but for now they're not. XXX
@@ -2234,6 +2329,7 @@ nuke_stacks()
Safefree(debname);
Safefree(debdelim);
} )
+<<<<
}
static PerlIO *tmpfp; /* moved outside init_lexer() because of UNICOS bug */
@@ -2250,6 +2346,7 @@ init_lexer()
static void
init_predump_symbols()
{
+ dTHR;
GV *tmpgv;
GV *othergv;
@@ -2533,6 +2630,7 @@ call_list(oldscope, list)
I32 oldscope;
AV* list;
{
+ dTHR;
line_t oldline = curcop->cop_line;
STRLEN len;
dJMPENV;
@@ -2605,6 +2703,12 @@ void
my_exit(status)
U32 status;
{
+ dTHR;
+
+#ifdef USE_THREADS
+ DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread 0x%lx, status %lu\n",
+ (unsigned long) thr, (unsigned long) status));
+#endif /* USE_THREADS */
switch (status) {
case 0:
STATUS_ALL_SUCCESS;
diff --git a/perl.h b/perl.h
index 8b3996bfeb..744905f453 100644
--- a/perl.h
+++ b/perl.h
@@ -52,6 +52,10 @@
# endif
#endif
+#ifdef USE_THREADS
+#include <pthread.h>
+#endif
+
/*
* SOFT_CAST can be used for args to prototyped functions to retain some
* type checking; it only casts if the compiler does not know prototypes.
@@ -988,6 +992,12 @@ union any {
void (*any_dptr) _((void*));
};
+#ifdef USE_THREADS
+#define ARGSproto struct thread *
+#else
+#define ARGSproto void
+#endif /* USE_THREADS */
+
/* Work around some cygwin32 problems with importing global symbols */
#if defined(CYGWIN32) && defined(DLLIMPORT)
# include "cw32imp.h"
@@ -1291,6 +1301,18 @@ typedef Sighandler_t Sigsave_t;
/* global state */
EXT PerlInterpreter * curinterp; /* currently running interpreter */
+#ifdef USE_THREADS
+EXT pthread_key_t thr_key; /* For per-thread struct thread ptr */
+EXT pthread_mutex_t sv_mutex; /* Mutex for allocating SVs in sv.c */
+EXT pthread_mutex_t malloc_mutex; /* Mutex for malloc */
+EXT pthread_mutex_t eval_mutex; /* Mutex for doeval */
+EXT pthread_cond_t eval_cond; /* Condition variable for doeval */
+EXT struct thread * eval_owner; /* Owner thread for doeval */
+EXT int nthreads; /* Number of threads currently */
+EXT pthread_mutex_t nthreads_mutex; /* Mutex for nthreads */
+EXT pthread_cond_t nthreads_cond; /* Condition variable for nthreads */
+#endif /* USE_THREADS */
+
/* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
#if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
#ifndef DONT_DECLARE_STD
@@ -1901,6 +1923,7 @@ struct interpreter {
};
#endif
+#include "thread.h"
#include "pp.h"
#ifdef __cplusplus
@@ -1976,6 +1999,9 @@ EXT MGVTBL vtbl_fm = {0, magic_setfm,
EXT MGVTBL vtbl_uvar = {magic_getuvar,
magic_setuvar,
0, 0, 0};
+#ifdef USE_THREADS
+EXT MGVTBL vtbl_mutex = {0, 0, 0, 0, magic_mutexfree};
+#endif /* USE_THREADS */
EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem,
0, 0, magic_freedefelem};
@@ -2015,6 +2041,11 @@ EXT MGVTBL vtbl_pos;
EXT MGVTBL vtbl_bm;
EXT MGVTBL vtbl_fm;
EXT MGVTBL vtbl_uvar;
+
+#ifdef USE_THREADS
+EXT MGVTBL vtbl_mutex;
+#endif /* USE_THREADS */
+
EXT MGVTBL vtbl_defelem;
#ifdef USE_LOCALE_COLLATE
diff --git a/pp.h b/pp.h
index 3c3bdcf9c0..f15c6e714d 100644
--- a/pp.h
+++ b/pp.h
@@ -7,10 +7,15 @@
*
*/
+#ifdef USE_THREADS
+#define ARGS thr
+#define dARGS struct thread *thr;
+#define PP(s) OP* s(ARGS) dARGS
+#else
#define ARGS
-#define ARGSproto void
#define dARGS
#define PP(s) OP* s(ARGS) dARGS
+#endif /* USE_THREADS */
#define SP sp
#define MARK mark
diff --git a/pp_ctl.c b/pp_ctl.c
index bc3ebb100f..82c59bf8a7 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -27,7 +27,7 @@
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));
@@ -533,8 +533,8 @@ PP(pp_grepstart)
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;
@@ -549,7 +549,7 @@ PP(pp_grepstart)
PUTBACK;
if (op->op_type == OP_MAPSTART)
- pp_pushmark(); /* push top */
+ pp_pushmark(ARGS); /* push top */
return ((LOGOP*)op->op_next)->op_other;
}
@@ -849,6 +849,7 @@ static I32
dopoptolabel(label)
char *label;
{
+ dTHR;
register I32 i;
register CONTEXT *cx;
@@ -895,6 +896,7 @@ dowantarray()
I32
block_gimme()
{
+ dTHR;
I32 cxix;
cxix = dopoptosub(cxstack_ix);
@@ -917,6 +919,7 @@ static I32
dopoptosub(startingblock)
I32 startingblock;
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
@@ -937,6 +940,7 @@ static I32
dopoptoeval(startingblock)
I32 startingblock;
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
@@ -956,6 +960,7 @@ static I32
dopoptoloop(startingblock)
I32 startingblock;
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
@@ -989,6 +994,7 @@ void
dounwind(cxix)
I32 cxix;
{
+ dTHR;
register CONTEXT *cx;
SV **newsp;
I32 optype;
@@ -1022,6 +1028,7 @@ OP *
die_where(message)
char *message;
{
+ dTHR;
if (in_eval) {
I32 cxix;
register CONTEXT *cx;
@@ -1120,7 +1127,7 @@ PP(pp_entersubr)
mark++;
}
*sp = cv;
- return pp_entersub();
+ return pp_entersub(ARGS);
}
#endif
@@ -1226,6 +1233,7 @@ sortcv(a, b)
const void *a;
const void *b;
{
+ dTHR;
SV * const *str1 = (SV * const *)a;
SV * const *str2 = (SV * const *)b;
I32 oldsaveix = savestack_ix;
@@ -1264,9 +1272,54 @@ const void *b;
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)
@@ -1276,6 +1329,7 @@ PP(pp_reset)
sv_reset(tmps, curcop->cop_stash);
PUSHs(&sv_yes);
RETURN;
+#endif /* USE_THREADS */
}
PP(pp_lineseq)
@@ -1634,8 +1688,8 @@ PP(pp_redo)
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;
@@ -1646,24 +1700,24 @@ 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) &&
@@ -1671,8 +1725,8 @@ OP **oplimit;
(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;
@@ -1939,7 +1993,7 @@ PP(pp_goto)
OP *oldop = op;
for (ix = 1; enterops[ix]; ix++) {
op = enterops[ix];
- (*op->op_ppaddr)();
+ (*op->op_ppaddr)(ARGS);
}
op = oldop;
}
@@ -2097,12 +2151,21 @@ static 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);
@@ -2122,10 +2185,20 @@ int gimme;
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);
@@ -2218,8 +2291,14 @@ int gimme;
/* 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);
}
diff --git a/pp_hot.c b/pp_hot.c
index e9fad16e57..46f0032b36 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -20,6 +20,43 @@
/* Hot code. */
+#ifdef USE_THREADS
+static void
+unset_cvowner(cvarg)
+void *cvarg;
+{
+ register CV* cv = (CV *) cvarg;
+#ifdef DEBUGGING
+ dTHR;
+#endif /* DEBUGGING */
+
+ DEBUG_L((fprintf(stderr, "0x%lx unsetting CvOWNER of 0x%lx:%s\n",
+ (unsigned long)thr, (unsigned long)cv, SvPEEK((SV*)cv))));
+ MUTEX_LOCK(CvMUTEXP(cv));
+ /* assert(CvDEPTH(cv) == 0); */
+ assert(thr == CvOWNER(cv));
+ CvOWNER(cv) = 0;
+ if (CvCONDP(cv))
+ COND_SIGNAL(CvCONDP(cv)); /* next please */
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ SvREFCNT_dec(cv);
+}
+
+#if 0
+void
+mutex_unlock(m)
+void *m;
+{
+#ifdef DEBUGGING
+ dTHR;
+ DEBUG_L((fprintf(stderr, "0x%lx unlocking mutex 0x%lx\n",
+ (unsigned long) thr, (unsigned long) m)));
+#endif /* DEBUGGING */
+ MUTEX_UNLOCK((pthread_mutex_t *) m);
+}
+#endif
+#endif /* USE_THREADS */
+
PP(pp_const)
{
dSP;
@@ -982,6 +1019,7 @@ ret_no:
OP *
do_readline()
{
+ dTHR;
dSP; dTARGETSTACKED;
register SV *sv;
STRLEN tmplen = 0;
@@ -1847,6 +1885,119 @@ PP(pp_entersub)
DIE("No DBsub routine");
}
+#ifdef USE_THREADS
+ MUTEX_LOCK(CvMUTEXP(cv));
+ if (!CvCONDP(cv)) {
+#ifdef DEBUGGING
+ DEBUG_L((fprintf(stderr, "0x%lx entering fast %s\n",
+ (unsigned long)thr, SvPEEK((SV*)cv))));
+#endif /* DEBUGGING */
+ MUTEX_UNLOCK(CvMUTEXP(cv)); /* fast sub wants neither sync nor clone */
+ }
+ else if (SvFLAGS(cv) & SVp_SYNC) {
+ /*
+ * It's a synchronised CV. Wait until it's free unless
+ * we own it already (in which case we're recursing).
+ */
+ if (CvOWNER(cv) && CvOWNER(cv) != thr) {
+ do {
+ DEBUG_L((fprintf(stderr, "0x%lx wait for 0x%lx to leave %s\n",
+ (unsigned long)thr,(unsigned long)CvOWNER(cv),
+ SvPEEK((SV*)cv))));
+ COND_WAIT(CvCONDP(cv), CvMUTEXP(cv)); /* yawn */
+ } while (CvOWNER(cv));
+ }
+ CvOWNER(cv) = thr; /* Assert ownership */
+ SvREFCNT_inc(cv);
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ if (CvDEPTH(cv) == 0)
+ SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
+ }
+ else {
+ /*
+ * It's an ordinary unsynchronised CV so we must distinguish
+ * three cases. (1) It's ours already (and we're recursing);
+ * (2) it's free (but we may already be using a cached clone);
+ * (3) another thread owns it. Case (1) is easy: we just use it.
+ * Case (2) means we look for a clone--if we have one, use it
+ * otherwise grab ownership of cv. Case (3) means look we for a
+ * clone and have to create one if we don't already have one.
+ * Why look for a clone in case (2) when we could just grab
+ * ownership of cv straight away? Well, we could be recursing,
+ * i.e. we originally tried to enter cv while another thread
+ * owned it (hence we used a clone) but it has been freed up
+ * and we're now recursing into it. It may or may not be "better"
+ * to use the clone but at least CvDEPTH can be trusted.
+ */
+ if (CvOWNER(cv) == thr)
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ else {
+ /* Case (2) or (3) */
+ SV **svp;
+
+ /*
+ * XXX Might it be better to release CvMUTEXP(cv) while we
+ * do the hv_fetch? We might find someone has pinched it
+ * when we look again, in which case we would be in case
+ * (3) instead of (2) so we'd have to clone. Would the fact
+ * that we released the mutex more quickly make up for this?
+ */
+ svp = hv_fetch(cvcache, (char *)cv, sizeof(cv), FALSE);
+ if (svp) {
+ /* We already have a clone to use */
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ cv = *(CV**)svp;
+ DEBUG_L(fprintf(stderr,
+ "entersub: 0x%lx already has clone 0x%lx:%s\n",
+ (unsigned long) thr, (unsigned long) cv,
+ SvPEEK((SV*)cv)));
+ CvOWNER(cv) = thr;
+ SvREFCNT_inc(cv);
+ if (CvDEPTH(cv) == 0)
+ SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
+ }
+ else {
+ /* (2) => grab ownership of cv. (3) => make clone */
+ if (!CvOWNER(cv)) {
+ CvOWNER(cv) = thr;
+ SvREFCNT_inc(cv);
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ DEBUG_L(fprintf(stderr,
+ "entersub: 0x%lx grabbing 0x%lx:%s\n",
+ (unsigned long) thr, (unsigned long) cv,
+ SvPEEK((SV*)cv)));
+ } else {
+ /* Make a new clone. */
+ CV *clonecv;
+ SvREFCNT_inc(cv); /* don't let it vanish from under us */
+ MUTEX_UNLOCK(CvMUTEXP(cv));
+ DEBUG_L((fprintf(stderr,
+ "entersub: 0x%lx cloning 0x%lx:%s\n",
+ (unsigned long) thr, (unsigned long) cv,
+ SvPEEK((SV*)cv))));
+ /*
+ * We're creating a new clone so there's no race
+ * between the original MUTEX_UNLOCK and the
+ * SvREFCNT_inc since no one will be trying to undef
+ * it out from underneath us. At least, I don't think
+ * there's a race...
+ */
+ clonecv = cv_clone(cv);
+ SvREFCNT_dec(cv); /* finished with this */
+ hv_store(cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0);
+ CvOWNER(clonecv) = thr;
+ cv = clonecv;
+ SvREFCNT_inc(cv);
+ }
+ assert(CvDEPTH(cv) == 0);
+ SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
+ }
+ }
+ }
+#endif /* USE_THREADS */
+
+ gimme = GIMME;
+
if (CvXSUB(cv)) {
if (CvOLDSTYLE(cv)) {
I32 (*fp3)_((int,int,int));
diff --git a/pp_sys.c b/pp_sys.c
index 03a10fea73..1b25bf4c55 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -530,7 +530,7 @@ PP(pp_tie)
XPUSHs((SV*)GvCV(gv));
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
SPAGAIN;
@@ -638,7 +638,7 @@ PP(pp_dbmopen)
if (perldb && curstash != debstash)
op->op_private |= OPpENTERSUB_DB;
PUTBACK;
- pp_pushmark();
+ pp_pushmark(ARGS);
EXTEND(sp, 5);
PUSHs(sv);
@@ -651,7 +651,7 @@ PP(pp_dbmopen)
PUSHs((SV*)GvCV(gv));
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
SPAGAIN;
@@ -659,7 +659,7 @@ PP(pp_dbmopen)
sp--;
op = (OP *) &myop;
PUTBACK;
- pp_pushmark();
+ pp_pushmark(ARGS);
PUSHs(sv);
PUSHs(left);
@@ -668,7 +668,7 @@ PP(pp_dbmopen)
PUSHs((SV*)GvCV(gv));
PUTBACK;
- if (op = pp_entersub())
+ if (op = pp_entersub(ARGS))
runops();
SPAGAIN;
}
@@ -823,6 +823,7 @@ void
setdefout(gv)
GV *gv;
{
+ dTHR;
if (gv)
(void)SvREFCNT_inc(gv);
if (defoutgv)
@@ -910,6 +911,7 @@ CV *cv;
GV *gv;
OP *retop;
{
+ dTHR;
register CONTEXT *cx;
I32 gimme = GIMME_V;
AV* padlist = CvPADLIST(cv);
diff --git a/proto.h b/proto.h
index a20ce43a74..28f239c412 100644
--- a/proto.h
+++ b/proto.h
@@ -13,7 +13,7 @@ bool Gv_AMupdate _((HV* stash));
OP* append_elem _((I32 optype, OP* head, OP* tail));
OP* append_list _((I32 optype, LISTOP* first, LISTOP* last));
I32 apply _((I32 type, SV** mark, SV** sp));
-void assertref _((OP* op));
+void assertref _((OP* o));
SV* avhv_delete _((AV *ar, char* key, U32 klen, I32 flags));
SV* avhv_delete_ent _((AV *ar, SV* keysv, I32 flags, U32 hash));
bool avhv_exists _((AV *ar, char* key, U32 klen));
@@ -52,8 +52,11 @@ U32 cast_ulong _((double f));
I32 my_chsize _((int fd, Off_t length));
#endif
OP* ck_gvconst _((OP* o));
-OP* ck_retarget _((OP* op));
-OP* convert _((I32 optype, I32 flags, OP* op));
+OP* ck_retarget _((OP* o));
+#ifdef USE_THREADS
+MAGIC * condpair_magic _((SV *sv));
+#endif
+OP* convert _((I32 optype, I32 flags, OP* o));
void croak _((const char* pat,...)) __attribute__((noreturn));
void cv_ckproto _((CV* cv, GV* gv, char* p));
CV* cv_clone _((CV* proto));
@@ -68,7 +71,7 @@ I32 filter_read _((int idx, SV* buffer, int maxlen));
I32 cxinc _((void));
void deb _((const char* pat,...)) __attribute__((format(printf,1,2)));
void deb_growlevel _((void));
-I32 debop _((OP* op));
+I32 debop _((OP* o));
I32 debstackptrs _((void));
#ifdef DEBUGGING
void debprofdump _((void));
@@ -91,7 +94,7 @@ I32 do_ipcctl _((I32 optype, SV** mark, SV** sp));
I32 do_ipcget _((I32 optype, SV** mark, SV** sp));
#endif
void do_join _((SV* sv, SV* del, SV** mark, SV** sp));
-OP* do_kv _((void));
+OP* do_kv _((ARGSproto));
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
I32 do_msgrcv _((SV** mark, SV** sp));
I32 do_msgsnd _((SV** mark, SV** sp));
@@ -134,7 +137,7 @@ OP* force_list _((OP* arg));
OP* fold_constants _((OP* arg));
char* form _((const char* pat, ...));
void free_tmps _((void));
-OP* gen_constant_list _((OP* op));
+OP* gen_constant_list _((OP* o));
void gp_free _((GV* gv));
GP* gp_ref _((GP* gp));
GV* gv_AVadd _((GV* gv));
@@ -179,6 +182,7 @@ void hv_undef _((HV* tb));
I32 ibcmp _((char* a, char* b, I32 len));
I32 ibcmp_locale _((char* a, char* b, I32 len));
I32 ingroup _((I32 testgid, I32 effective));
+void init_stacks _((ARGSproto));
U32 intro_my _((void));
char* instr _((char* big, char* little));
bool io_close _((IO* io));
@@ -188,7 +192,7 @@ I32 keyword _((char* d, I32 len));
void leave_scope _((I32 base));
void lex_end _((void));
void lex_start _((SV* line));
-OP* linklist _((OP* op));
+OP* linklist _((OP* o));
OP* list _((OP* o));
OP* listkids _((OP* o));
OP* localize _((OP* arg, I32 lexical));
@@ -208,6 +212,9 @@ int magic_getsig _((SV* sv, MAGIC* mg));
int magic_gettaint _((SV* sv, MAGIC* mg));
int magic_getuvar _((SV* sv, MAGIC* mg));
U32 magic_len _((SV* sv, MAGIC* mg));
+#ifdef USE_THREADS
+int magic_mutexfree _((SV* sv, MAGIC* mg));
+#endif /* USE_THREADS */
int magic_nextpack _((SV* sv, MAGIC* mg, SV* key));
int magic_set _((SV* sv, MAGIC* mg));
#ifdef OVERLOAD
@@ -249,9 +256,12 @@ int mg_get _((SV* sv));
U32 mg_len _((SV* sv));
void mg_magical _((SV* sv));
int mg_set _((SV* sv));
-OP* mod _((OP* op, I32 type));
+OP* mod _((OP* o, I32 type));
char* moreswitches _((char* s));
-OP* my _((OP* op));
+#ifdef USE_THREADS
+void mutex_unlock _((void *m));
+#endif /* USE_THREADS */
+OP* my _((OP* o));
#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
char* my_bcopy _((char* from, char* to, I32 len));
#endif
@@ -260,7 +270,7 @@ char* my_bzero _((char* loc, I32 len));
#endif
void my_exit _((U32 status)) __attribute__((noreturn));
void my_failure_exit _((void)) __attribute__((noreturn));
-I32 my_lstat _((void));
+I32 my_lstat _((ARGSproto));
#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP)
I32 my_memcmp _((char* s1, char* s2, I32 len));
#endif
@@ -270,30 +280,30 @@ void* my_memset _((char* loc, I32 ch, I32 len));
I32 my_pclose _((PerlIO* ptr));
PerlIO* my_popen _((char* cmd, char* mode));
void my_setenv _((char* nam, char* val));
-I32 my_stat _((void));
+I32 my_stat _((ARGSproto));
#ifdef MYSWAP
short my_swap _((short s));
long my_htonl _((long l));
long my_ntohl _((long l));
#endif
void my_unexec _((void));
-OP* newANONLIST _((OP* op));
-OP* newANONHASH _((OP* op));
+OP* newANONLIST _((OP* o));
+OP* newANONHASH _((OP* o));
OP* newANONSUB _((I32 floor, OP* proto, OP* block));
OP* newASSIGNOP _((I32 flags, OP* left, I32 optype, OP* right));
OP* newCONDOP _((I32 flags, OP* expr, OP* trueop, OP* falseop));
-void newFORM _((I32 floor, OP* op, OP* block));
+void newFORM _((I32 floor, OP* o, OP* block));
OP* newFOROP _((I32 flags, char* label, line_t forline, OP* scalar, OP* expr, OP*block, OP*cont));
OP* newLOGOP _((I32 optype, I32 flags, OP* left, OP* right));
OP* newLOOPEX _((I32 type, OP* label));
OP* newLOOPOP _((I32 flags, I32 debuggable, OP* expr, OP* block));
OP* newNULLLIST _((void));
OP* newOP _((I32 optype, I32 flags));
-void newPROG _((OP* op));
+void newPROG _((OP* o));
OP* newRANGE _((I32 flags, OP* left, OP* right));
OP* newSLICEOP _((I32 flags, OP* subscript, OP* list));
OP* newSTATEOP _((I32 flags, char* label, OP* o));
-CV* newSUB _((I32 floor, OP* op, OP* proto, OP* block));
+CV* newSUB _((I32 floor, OP* o, OP* proto, OP* block));
CV* newXS _((char* name, void (*subaddr)(CV* cv), char* filename));
#ifdef DEPRECATED
CV* newXSUB _((char* name, I32 ix, I32 (*subaddr)(int,int,int), char* filename));
@@ -331,7 +341,7 @@ PerlIO* nextargv _((GV* gv));
char* ninstr _((char* big, char* bigend, char* little, char* lend));
OP* oopsCV _((OP* o));
void op_free _((OP* arg));
-void package _((OP* op));
+void package _((OP* o));
PADOFFSET pad_alloc _((I32 optype, U32 tmptype));
PADOFFSET pad_allocmy _((char* name));
PADOFFSET pad_findmy _((char* name));
@@ -342,7 +352,7 @@ SV* pad_sv _((PADOFFSET po));
void pad_free _((PADOFFSET po));
void pad_reset _((void));
void pad_swipe _((PADOFFSET po));
-void peep _((OP* op));
+void peep _((OP* o));
PerlInterpreter* perl_alloc _((void));
I32 perl_call_argv _((char* subname, I32 flags, char** argv));
I32 perl_call_method _((char* methname, I32 flags));
@@ -371,20 +381,20 @@ int perl_run _((PerlInterpreter* sv_interp));
void pidgone _((int pid, int status));
void pmflag _((U16* pmfl, int ch));
OP* pmruntime _((OP* pm, OP* expr, OP* repl));
-OP* pmtrans _((OP* op, OP* expr, OP* repl));
+OP* pmtrans _((OP* o, OP* expr, OP* repl));
OP* pop_return _((void));
void pop_scope _((void));
OP* prepend_elem _((I32 optype, OP* head, OP* tail));
-void push_return _((OP* op));
+void push_return _((OP* o));
void push_scope _((void));
regexp* pregcomp _((char* exp, char* xend, PMOP* pm));
-OP* ref _((OP* op, I32 type));
-OP* refkids _((OP* op, I32 type));
+OP* ref _((OP* o, I32 type));
+OP* refkids _((OP* o, I32 type));
void regdump _((regexp* r));
I32 pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, I32 safebase));
void pregfree _((struct regexp* r));
char* regnext _((char* p));
-void regprop _((SV* sv, char* op));
+void regprop _((SV* sv, char* o));
void repeatcpy _((char* to, char* from, I32 len, I32 count));
char* rninstr _((char* big, char* bigend, char* little, char* lend));
Sighandler_t rsignal _((int, Sighandler_t));
@@ -409,7 +419,7 @@ void save_delete _((HV* hv, char* key, I32 klen));
void save_destructor _((void (*f)(void*), void* p));
#endif /* titan */
void save_freesv _((SV* sv));
-void save_freeop _((OP* op));
+void save_freeop _((OP* o));
void save_freepv _((char* pv));
void save_gp _((GV* gv, I32 empty));
HV* save_hash _((GV* gv));
@@ -428,9 +438,9 @@ void save_sptr _((SV** sptr));
SV* save_svref _((SV** sptr));
OP* sawparens _((OP* o));
OP* scalar _((OP* o));
-OP* scalarkids _((OP* op));
+OP* scalarkids _((OP* o));
OP* scalarseq _((OP* o));
-OP* scalarvoid _((OP* op));
+OP* scalarvoid _((OP* o));
UV scan_hex _((char* start, I32 len, I32* retlen));
char* scan_num _((char* s));
UV scan_oct _((char* start, I32 len, I32* retlen));
diff --git a/regcomp.c b/regcomp.c
index d3788c8f16..516cfef151 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -58,6 +58,10 @@
#include "INTERN.h"
#include "regcomp.h"
+#ifdef USE_THREADS
+#undef op
+#endif /* USE_THREADS */
+
#ifdef MSDOS
# if defined(BUGGY_MSC6)
/* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
@@ -1590,14 +1594,14 @@ regexp *r;
- regprop - printable representation of opcode
*/
void
-regprop(sv, op)
+regprop(sv, o)
SV *sv;
-char *op;
+char *o;
{
register char *p = 0;
sv_setpv(sv, ":");
- switch (OP(op)) {
+ switch (OP(o)) {
case BOL:
p = "BOL";
break;
@@ -1659,19 +1663,19 @@ char *op;
p = "NBOUNDL";
break;
case CURLY:
- sv_catpvf(sv, "CURLY {%d,%d}", ARG1(op), ARG2(op));
+ sv_catpvf(sv, "CURLY {%d,%d}", ARG1(o), ARG2(o));
break;
case CURLYX:
- sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(op), ARG2(op));
+ sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(o), ARG2(o));
break;
case REF:
- sv_catpvf(sv, "REF%d", ARG1(op));
+ sv_catpvf(sv, "REF%d", ARG1(o));
break;
case OPEN:
- sv_catpvf(sv, "OPEN%d", ARG1(op));
+ sv_catpvf(sv, "OPEN%d", ARG1(o));
break;
case CLOSE:
- sv_catpvf(sv, "CLOSE%d", ARG1(op));
+ sv_catpvf(sv, "CLOSE%d", ARG1(o));
p = NULL;
break;
case STAR:
diff --git a/regexec.c b/regexec.c
index 630b130c88..e851808ad6 100644
--- a/regexec.c
+++ b/regexec.c
@@ -89,6 +89,7 @@ static CHECKPOINT
regcppush(parenfloor)
I32 parenfloor;
{
+ dTHR;
int retval = savestack_ix;
int i = (regsize - parenfloor) * 3;
int p;
@@ -110,6 +111,7 @@ I32 parenfloor;
static char *
regcppop()
{
+ dTHR;
I32 i = SSPOPINT;
U32 paren = 0;
char *input;
@@ -863,6 +865,7 @@ char *prog;
*reglastparen = n;
break;
case CURLYX: {
+ dTHR;
CURCUR cc;
CHECKPOINT cp = savestack_ix;
cc.oldcc = regcc;
diff --git a/run.c b/run.c
index 0ce2b9ffed..e41616019c 100644
--- a/run.c
+++ b/run.c
@@ -23,10 +23,11 @@ dEXT char *watchok;
int
runops() {
+ dTHR;
SAVEI32(runlevel);
runlevel++;
- while ( op = (*op->op_ppaddr)() ) ;
+ while ( op = (*op->op_ppaddr)(ARGS) ) ;
TAINT_NOT;
return 0;
@@ -34,10 +35,11 @@ runops() {
#else
-static void debprof _((OP*op));
+static void debprof _((OP*o));
int
runops() {
+ dTHR;
if (!op) {
warn("NULL OP IN RUN");
return 0;
@@ -54,28 +56,31 @@ runops() {
DEBUG_s(debstack());
DEBUG_t(debop(op));
DEBUG_P(debprof(op));
+#ifdef USE_THREADS
+ DEBUG_L(YIELD()); /* shake up scheduling a bit */
+#endif /* USE_THREADS */
}
- } while ( op = (*op->op_ppaddr)() );
+ } while ( op = (*op->op_ppaddr)(ARGS) );
TAINT_NOT;
return 0;
}
I32
-debop(op)
-OP *op;
+debop(o)
+OP *o;
{
SV *sv;
- deb("%s", op_name[op->op_type]);
- switch (op->op_type) {
+ deb("%s", op_name[o->op_type]);
+ switch (o->op_type) {
case OP_CONST:
- PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOP->op_sv));
+ PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv));
break;
case OP_GVSV:
case OP_GV:
- if (cGVOP->op_gv) {
+ if (cGVOPo->op_gv) {
sv = NEWSV(0,0);
- gv_fullname3(sv, cGVOP->op_gv, Nullch);
+ gv_fullname3(sv, cGVOPo->op_gv, Nullch);
PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, na));
SvREFCNT_dec(sv);
}
@@ -100,12 +105,12 @@ char **addr;
}
static void
-debprof(op)
-OP* op;
+debprof(o)
+OP* o;
{
if (!profiledata)
New(000, profiledata, MAXO, U32);
- ++profiledata[op->op_type];
+ ++profiledata[o->op_type];
}
void
diff --git a/scope.c b/scope.c
index 0487ebefbd..cf58e24f0e 100644
--- a/scope.c
+++ b/scope.c
@@ -21,6 +21,7 @@ SV** sp;
SV** p;
int n;
{
+ dTHR;
stack_sp = sp;
av_extend(curstack, (p - stack_base) + (n) + 128);
return stack_sp;
@@ -29,6 +30,7 @@ int n;
I32
cxinc()
{
+ dTHR;
cxstack_max = cxstack_max * 3 / 2;
Renew(cxstack, cxstack_max + 1, CONTEXT); /* XXX should fix CXINC macro */
return cxstack_ix + 1;
@@ -38,6 +40,7 @@ void
push_return(retop)
OP *retop;
{
+ dTHR;
if (retstack_ix == retstack_max) {
retstack_max = retstack_max * 3 / 2;
Renew(retstack, retstack_max, OP*);
@@ -48,6 +51,7 @@ OP *retop;
OP *
pop_return()
{
+ dTHR;
if (retstack_ix > 0)
return retstack[--retstack_ix];
else
@@ -57,6 +61,7 @@ pop_return()
void
push_scope()
{
+ dTHR;
if (scopestack_ix == scopestack_max) {
scopestack_max = scopestack_max * 3 / 2;
Renew(scopestack, scopestack_max, I32);
@@ -68,6 +73,7 @@ push_scope()
void
pop_scope()
{
+ dTHR;
I32 oldsave = scopestack[--scopestack_ix];
LEAVE_SCOPE(oldsave);
}
@@ -75,6 +81,7 @@ pop_scope()
void
markstack_grow()
{
+ dTHR;
I32 oldmax = markstack_max - markstack;
I32 newmax = oldmax * 3 / 2;
@@ -86,6 +93,7 @@ markstack_grow()
void
savestack_grow()
{
+ dTHR;
savestack_max = savestack_max * 3 / 2;
Renew(savestack, savestack_max, ANY);
}
@@ -93,6 +101,7 @@ savestack_grow()
void
free_tmps()
{
+ dTHR;
/* XXX should tmps_floor live in cxstack? */
I32 myfloor = tmps_floor;
while (tmps_ix > myfloor) { /* clean up after last statement */
@@ -111,6 +120,7 @@ static SV *
save_scalar_at(sptr)
SV **sptr;
{
+ dTHR;
register SV *sv;
SV *osv = *sptr;
@@ -142,6 +152,7 @@ SV *
save_scalar(gv)
GV *gv;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(gv);
SSPUSHPTR(GvSV(gv));
@@ -153,6 +164,7 @@ SV*
save_svref(sptr)
SV **sptr;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(sptr);
SSPUSHPTR(*sptr);
@@ -188,6 +200,7 @@ AV *
save_ary(gv)
GV *gv;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(gv);
SSPUSHPTR(GvAVn(gv));
@@ -201,6 +214,7 @@ HV *
save_hash(gv)
GV *gv;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(gv);
SSPUSHPTR(GvHVn(gv));
@@ -214,6 +228,7 @@ void
save_item(item)
register SV *item;
{
+ dTHR;
register SV *sv;
SSCHECK(3);
@@ -228,6 +243,7 @@ void
save_int(intp)
int *intp;
{
+ dTHR;
SSCHECK(3);
SSPUSHINT(*intp);
SSPUSHPTR(intp);
@@ -238,6 +254,7 @@ void
save_long(longp)
long *longp;
{
+ dTHR;
SSCHECK(3);
SSPUSHLONG(*longp);
SSPUSHPTR(longp);
@@ -248,6 +265,7 @@ void
save_I32(intp)
I32 *intp;
{
+ dTHR;
SSCHECK(3);
SSPUSHINT(*intp);
SSPUSHPTR(intp);
@@ -268,6 +286,7 @@ void
save_iv(ivp)
IV *ivp;
{
+ dTHR;
SSCHECK(3);
SSPUSHIV(*ivp);
SSPUSHPTR(ivp);
@@ -281,6 +300,7 @@ void
save_pptr(pptr)
char **pptr;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*pptr);
SSPUSHPTR(pptr);
@@ -291,6 +311,7 @@ void
save_sptr(sptr)
SV **sptr;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*sptr);
SSPUSHPTR(sptr);
@@ -301,6 +322,7 @@ void
save_nogv(gv)
GV *gv;
{
+ dTHR;
SSCHECK(2);
SSPUSHPTR(gv);
SSPUSHINT(SAVEt_NSTAB);
@@ -310,6 +332,7 @@ void
save_hptr(hptr)
HV **hptr;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*hptr);
SSPUSHPTR(hptr);
@@ -320,6 +343,7 @@ void
save_aptr(aptr)
AV **aptr;
{
+ dTHR;
SSCHECK(3);
SSPUSHPTR(*aptr);
SSPUSHPTR(aptr);
@@ -330,17 +354,19 @@ void
save_freesv(sv)
SV *sv;
{
+ dTHR;
SSCHECK(2);
SSPUSHPTR(sv);
SSPUSHINT(SAVEt_FREESV);
}
void
-save_freeop(op)
-OP *op;
+save_freeop(o)
+OP *o;
{
+ dTHR;
SSCHECK(2);
- SSPUSHPTR(op);
+ SSPUSHPTR(o);
SSPUSHINT(SAVEt_FREEOP);
}
@@ -348,6 +374,7 @@ void
save_freepv(pv)
char *pv;
{
+ dTHR;
SSCHECK(2);
SSPUSHPTR(pv);
SSPUSHINT(SAVEt_FREEPV);
@@ -357,6 +384,7 @@ void
save_clearsv(svp)
SV** svp;
{
+ dTHR;
SSCHECK(2);
SSPUSHLONG((long)(svp-curpad));
SSPUSHINT(SAVEt_CLEARSV);
@@ -368,6 +396,7 @@ HV *hv;
char *key;
I32 klen;
{
+ dTHR;
SSCHECK(4);
SSPUSHINT(klen);
SSPUSHPTR(key);
@@ -380,6 +409,7 @@ save_list(sarg,maxsarg)
register SV **sarg;
I32 maxsarg;
{
+ dTHR;
register SV *sv;
register I32 i;
@@ -398,6 +428,7 @@ save_destructor(f,p)
void (*f) _((void*));
void* p;
{
+ dTHR;
SSCHECK(3);
SSPUSHDPTR(f);
SSPUSHPTR(p);
@@ -408,6 +439,7 @@ void
leave_scope(base)
I32 base;
{
+ dTHR;
register SV *sv;
register SV *value;
register GV *gv;
@@ -614,6 +646,7 @@ void
cx_dump(cx)
CONTEXT* cx;
{
+ dTHR;
PerlIO_printf(Perl_debug_log, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]);
if (cx->cx_type != CXt_SUBST) {
PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
diff --git a/sv.c b/sv.c
index ece94b93ac..1331f89256 100644
--- a/sv.c
+++ b/sv.c
@@ -172,9 +172,11 @@ U32 flags;
#define uproot_SV(p) \
do { \
+ MUTEX_LOCK(&sv_mutex); \
(p) = sv_root; \
sv_root = (SV*)SvANY(p); \
++sv_count; \
+ MUTEX_UNLOCK(&sv_mutex); \
} while (0)
#define new_SV(p) \
@@ -1120,8 +1122,11 @@ IV i;
case SVt_PVCV:
case SVt_PVFM:
case SVt_PVIO:
- croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
- op_desc[op->op_type]);
+ {
+ dTHR;
+ croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
+ op_desc[op->op_type]);
+ }
}
(void)SvIOK_only(sv); /* validate number */
SvIVX(sv) = i;
@@ -1179,8 +1184,11 @@ double num;
case SVt_PVCV:
case SVt_PVFM:
case SVt_PVIO:
- croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
- op_name[op->op_type]);
+ {
+ dTHR;
+ croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
+ op_name[op->op_type]);
+ }
}
SvNVX(sv) = num;
(void)SvNOK_only(sv); /* validate number */
@@ -1191,6 +1199,7 @@ static void
not_a_number(sv)
SV *sv;
{
+ dTHR;
char tmpbuf[64];
char *d = tmpbuf;
char *s;
@@ -1312,6 +1321,7 @@ register SV *sv;
SvIVX(sv) = asIV(sv);
}
else {
+ dTHR;
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0;
@@ -1460,6 +1470,7 @@ register SV *sv;
SvNVX(sv) = atof(SvPVX(sv));
}
else {
+ dTHR;
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
return 0.0;
@@ -1717,6 +1728,7 @@ STRLEN *lp;
s = SvEND(sv);
}
else {
+ dTHR;
if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
warn(warn_uninit);
*lp = 0;
@@ -1781,6 +1793,7 @@ register SV *sv;
if (SvROK(sv)) {
#ifdef OVERLOAD
{
+ dTHR;
SV* tmpsv;
if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
return SvTRUE(tmpsv);
@@ -1789,11 +1802,11 @@ register SV *sv;
return SvRV(sv) != 0;
}
if (SvPOKp(sv)) {
- register XPV* Xpv;
- if ((Xpv = (XPV*)SvANY(sv)) &&
- (*Xpv->xpv_pv > '0' ||
- Xpv->xpv_cur > 1 ||
- (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+ register XPV* Xpvtmp;
+ if ((Xpvtmp = (XPV*)SvANY(sv)) &&
+ (*Xpvtmp->xpv_pv > '0' ||
+ Xpvtmp->xpv_cur > 1 ||
+ (Xpvtmp->xpv_cur && *Xpvtmp->xpv_pv != '0')))
return 1;
else
return 0;
@@ -1820,6 +1833,7 @@ sv_setsv(dstr,sstr)
SV *dstr;
register SV *sstr;
{
+ dTHR;
register U32 sflags;
register int dtype;
register int stype;
@@ -1963,6 +1977,7 @@ register SV *sstr;
if (sflags & SVf_ROK) {
if (dtype >= SVt_PV) {
if (dtype == SVt_PVGV) {
+ dTHR;
SV *sref = SvREFCNT_inc(SvRV(sstr));
SV *dref = 0;
int intro = GvINTRO(dstr);
@@ -2386,6 +2401,7 @@ I32 namlen;
if (!obj || obj == sv || how == '#')
mg->mg_obj = obj;
else {
+ dTHR;
mg->mg_obj = SvREFCNT_inc(obj);
mg->mg_flags |= MGf_REFCOUNTED;
}
@@ -2443,6 +2459,11 @@ I32 namlen;
case 'l':
mg->mg_virtual = &vtbl_dbline;
break;
+#ifdef USE_THREADS
+ case 'm':
+ mg->mg_virtual = &vtbl_mutex;
+ break;
+#endif /* USE_THREADS */
#ifdef USE_LOCALE_COLLATE
case 'o':
mg->mg_virtual = &vtbl_collxfrm;
@@ -2661,6 +2682,7 @@ register SV *sv;
if (SvOBJECT(sv)) {
if (defstash) { /* Still have a symbol table? */
+ dTHR;
dSP;
GV* destructor;
@@ -3413,6 +3435,7 @@ register SV *sv;
static void
sv_mortalgrow()
{
+ dTHR;
tmps_max += (tmps_max < 512) ? 128 : 512;
Renew(tmps_stack, tmps_max, SV*);
}
@@ -3421,6 +3444,7 @@ SV *
sv_mortalcopy(oldstr)
SV *oldstr;
{
+ dTHR;
register SV *sv;
new_SV(sv);
@@ -3438,6 +3462,7 @@ SV *oldstr;
SV *
sv_newmortal()
{
+ dTHR;
register SV *sv;
new_SV(sv);
@@ -3456,6 +3481,7 @@ SV *
sv_2mortal(sv)
register SV *sv;
{
+ dTHR;
if (!sv)
return sv;
if (SvREADONLY(sv) && curcop != &compiling)
@@ -3545,6 +3571,7 @@ SV *
newRV(ref)
SV *ref;
{
+ dTHR;
register SV *sv;
new_SV(sv);
@@ -3861,9 +3888,11 @@ STRLEN *lp;
s = SvPVX(sv);
*lp = SvCUR(sv);
}
- else
+ else {
+ dTHR;
croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
op_name[op->op_type]);
+ }
}
else
s = sv_2pv(sv, lp);
@@ -3960,6 +3989,7 @@ newSVrv(rv, classname)
SV *rv;
char *classname;
{
+ dTHR;
SV *sv;
new_SV(sv);
@@ -4026,6 +4056,7 @@ sv_bless(sv,stash)
SV* sv;
HV* stash;
{
+ dTHR;
SV *ref;
if (!SvROK(sv))
croak("Can't bless non-reference value");
@@ -4872,6 +4903,11 @@ SV* sv;
PerlIO_printf(Perl_debug_log, " DEPTH = %ld\n", (long)CvDEPTH(sv));
PerlIO_printf(Perl_debug_log, " PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
PerlIO_printf(Perl_debug_log, " OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
+#ifdef USE_THREADS
+ PerlIO_printf(Perl_debug_log, " MUTEXP = 0x%lx\n", (long)CvMUTEXP(sv));
+ PerlIO_printf(Perl_debug_log, " CONDP = 0x%lx\n", (long)CvCONDP(sv));
+ PerlIO_printf(Perl_debug_log, " OWNER = 0x%lx\n", (long)CvOWNER(sv));
+#endif /* USE_THREADS */
if (type == SVt_PVFM)
PerlIO_printf(Perl_debug_log, " LINES = %ld\n", (long)FmLINES(sv));
break;
diff --git a/sv.h b/sv.h
index cf18061381..f52c09d43d 100644
--- a/sv.h
+++ b/sv.h
@@ -131,6 +131,10 @@ struct io {
#define SVphv_SHAREKEYS 0x20000000 /* keys live on shared string table */
#define SVphv_LAZYDEL 0x40000000 /* entry in xhv_eiter must be deleted */
+#ifdef USE_THREADS
+#define SVp_SYNC 0x10000000 /* Synchronised CV or an SV lock */
+#endif /* USE_THREADS */
+
struct xrv {
SV * xrv_rv; /* pointer to another SV */
};
diff --git a/thread.h b/thread.h
new file mode 100644
index 0000000000..466dea5520
--- /dev/null
+++ b/thread.h
@@ -0,0 +1,235 @@
+#ifndef USE_THREADS
+#define MUTEX_LOCK(m)
+#define MUTEX_UNLOCK(m)
+#define MUTEX_INIT(m)
+#define MUTEX_DESTROY(m)
+#define COND_INIT(c)
+#define COND_SIGNAL(c)
+#define COND_BROADCAST(c)
+#define COND_WAIT(c, m)
+#define COND_DESTROY(c)
+
+#define THR
+/* Rats: if dTHR is just blank then the subsequent ";" throws an error */
+#define dTHR extern int errno
+#else
+#include <pthread.h>
+
+#ifdef OLD_PTHREADS_API
+#define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
+#define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
+#define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d))
+#else
+#define pthread_mutexattr_default NULL
+#endif /* OLD_PTHREADS_API */
+
+#define MUTEX_INIT(m) \
+ if (pthread_mutex_init((m), pthread_mutexattr_default)) \
+ croak("panic: MUTEX_INIT"); \
+ else 1
+#define MUTEX_LOCK(m) \
+ if (pthread_mutex_lock((m))) croak("panic: MUTEX_LOCK"); else 1
+#define MUTEX_UNLOCK(m) \
+ if (pthread_mutex_unlock((m))) croak("panic: MUTEX_UNLOCK"); else 1
+#define MUTEX_DESTROY(m) \
+ if (pthread_mutex_destroy((m))) croak("panic: MUTEX_DESTROY"); else 1
+#define COND_INIT(c) \
+ if (pthread_cond_init((c), NULL)) croak("panic: COND_INIT"); else 1
+#define COND_SIGNAL(c) \
+ if (pthread_cond_signal((c))) croak("panic: COND_SIGNAL"); else 1
+#define COND_BROADCAST(c) \
+ if (pthread_cond_broadcast((c))) croak("panic: COND_BROADCAST"); else 1
+#define COND_WAIT(c, m) \
+ if (pthread_cond_wait((c), (m))) croak("panic: COND_WAIT"); else 1
+#define COND_DESTROY(c) \
+ if (pthread_cond_destroy((c))) croak("panic: COND_DESTROY"); else 1
+/* XXX Add "old" (?) POSIX draft interface too */
+#ifdef OLD_PTHREADS_API
+struct thread *getTHR _((void));
+#define THR getTHR()
+#else
+#define THR ((struct thread *) pthread_getspecific(thr_key))
+#endif /* OLD_PTHREADS_API */
+#define dTHR struct thread *thr = THR
+
+struct thread {
+ pthread_t Tself;
+
+ /* The fields that used to be global */
+ SV ** Tstack_base;
+ SV ** Tstack_sp;
+ SV ** Tstack_max;
+
+ OP * Top;
+
+ I32 * Tscopestack;
+ I32 Tscopestack_ix;
+ I32 Tscopestack_max;
+
+ ANY * Tsavestack;
+ I32 Tsavestack_ix;
+ I32 Tsavestack_max;
+
+ OP ** Tretstack;
+ I32 Tretstack_ix;
+ I32 Tretstack_max;
+
+ I32 * Tmarkstack;
+ I32 * Tmarkstack_ptr;
+ I32 * Tmarkstack_max;
+
+ SV ** Tcurpad;
+
+ SV * TSv;
+ XPV * TXpv;
+ char Tbuf[2048]; /* should be a global locked by a mutex */
+ char Ttokenbuf[256]; /* should be a global locked by a mutex */
+ struct stat Tstatbuf;
+ struct tms Ttimesbuf;
+
+ /* XXX What about regexp stuff? */
+
+ /* Now the fields that used to be "per interpreter" (even when global) */
+
+ /* XXX What about magic variables such as $/, $? and so on? */
+ HV * Tdefstash;
+ HV * Tcurstash;
+ AV * Tpad;
+ AV * Tpadname;
+
+ SV ** Ttmps_stack;
+ I32 Ttmps_ix;
+ I32 Ttmps_floor;
+ I32 Ttmps_max;
+
+ int Tin_eval;
+ OP * Trestartop;
+ int Tdelaymagic;
+ bool Tdirty;
+ U8 Tlocalizing;
+
+ CONTEXT * Tcxstack;
+ I32 Tcxstack_ix;
+ I32 Tcxstack_max;
+
+ AV * Tstack;
+ AV * Tmainstack;
+ Sigjmp_buf Ttop_env;
+ I32 Trunlevel;
+
+ /* XXX Sort stuff, firstgv, secongv and so on? */
+
+ pthread_mutex_t * Tthreadstart_mutexp;
+ HV * Tcvcache;
+ U32 Tthrflags;
+};
+
+typedef struct thread *Thread;
+
+/* Values and macros for thrflags */
+#define THR_STATE_MASK 3
+#define THR_NORMAL 0
+#define THR_DETACHED 1
+#define THR_JOINED 2
+#define THR_DEAD 3
+
+#define ThrSTATE(t) (t->Tthrflags & THR_STATE_MASK)
+#define ThrSETSTATE(t, s) STMT_START { \
+ (t)->Tthrflags &= ~THR_STATE_MASK; \
+ (t)->Tthrflags |= (s); \
+ DEBUG_L(fprintf(stderr, "thread 0x%lx set to state %d\n", \
+ (unsigned long)(t), (s))); \
+ } STMT_END
+
+typedef struct condpair {
+ pthread_mutex_t mutex;
+ pthread_cond_t owner_cond;
+ pthread_cond_t cond;
+ Thread owner;
+} condpair_t;
+
+#define MgMUTEXP(mg) (&((condpair_t *)(mg->mg_ptr))->mutex)
+#define MgOWNERCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->owner_cond)
+#define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond)
+#define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner
+
+#undef stack_base
+#undef stack_sp
+#undef stack_max
+#undef stack
+#undef mainstack
+#undef markstack
+#undef markstack_ptr
+#undef markstack_max
+#undef scopestack
+#undef scopestack_ix
+#undef scopestack_max
+#undef savestack
+#undef savestack_ix
+#undef savestack_max
+#undef retstack
+#undef retstack_ix
+#undef retstack_max
+#undef cxstack
+#undef cxstack_ix
+#undef cxstack_max
+#undef curpad
+#undef Sv
+#undef Xpv
+#undef op
+#undef top_env
+#undef runlevel
+#undef in_eval
+
+#define self (thr->Tself)
+#define stack_base (thr->Tstack_base)
+#define stack_sp (thr->Tstack_sp)
+#define stack_max (thr->Tstack_max)
+#define op (thr->Top)
+#define stack (thr->Tstack)
+#define mainstack (thr->Tmainstack)
+#define markstack (thr->Tmarkstack)
+#define markstack_ptr (thr->Tmarkstack_ptr)
+#define markstack_max (thr->Tmarkstack_max)
+#define scopestack (thr->Tscopestack)
+#define scopestack_ix (thr->Tscopestack_ix)
+#define scopestack_max (thr->Tscopestack_max)
+
+#define savestack (thr->Tsavestack)
+#define savestack_ix (thr->Tsavestack_ix)
+#define savestack_max (thr->Tsavestack_max)
+
+#define retstack (thr->Tretstack)
+#define retstack_ix (thr->Tretstack_ix)
+#define retstack_max (thr->Tretstack_max)
+
+#define cxstack (thr->Tcxstack)
+#define cxstack_ix (thr->Tcxstack_ix)
+#define cxstack_max (thr->Tcxstack_max)
+
+#define curpad (thr->Tcurpad)
+#define Sv (thr->TSv)
+#define Xpv (thr->TXpv)
+#define defstash (thr->Tdefstash)
+#define curstash (thr->Tcurstash)
+#define pad (thr->Tpad)
+#define padname (thr->Tpadname)
+
+#define tmps_stack (thr->Ttmps_stack)
+#define tmps_ix (thr->Ttmps_ix)
+#define tmps_floor (thr->Ttmps_floor)
+#define tmps_max (thr->Ttmps_max)
+
+#define in_eval (thr->Tin_eval)
+#define restartop (thr->Trestartop)
+#define delaymagic (thr->Tdelaymagic)
+#define dirty (thr->Tdirty)
+#define localizing (thr->Tlocalizing)
+
+#define top_env (thr->Ttop_env)
+#define runlevel (thr->Trunlevel)
+
+#define threadstart_mutexp (thr->Tthreadstart_mutexp)
+#define cvcache (thr->Tcvcache)
+#define thrflags (thr->Tthrflags)
+#endif /* USE_THREADS */
diff --git a/toke.c b/toke.c
index 18f72668b2..7fddc3c7ea 100644
--- a/toke.c
+++ b/toke.c
@@ -350,6 +350,7 @@ static char *
skipspace(s)
register char *s;
{
+ dTHR;
if (lex_formbrack && lex_brackets <= lex_formbrack) {
while (s < bufend && (*s == ' ' || *s == '\t'))
s++;
@@ -531,11 +532,11 @@ register char *s;
int kind;
{
if (s && *s) {
- OP* op = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
- nextval[nexttoke].opval = op;
+ OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
+ nextval[nexttoke].opval = o;
force_next(WORD);
if (kind) {
- op->op_private = OPpCONST_ENTERED;
+ o->op_private = OPpCONST_ENTERED;
/* XXX see note in pp_entereval() for why we forgo typo
warnings if the symbol must be introduced in an eval.
GSAR 96-10-12 */
@@ -1226,6 +1227,7 @@ EXT int yychar; /* last token */
int
yylex()
{
+ dTHR;
register char *s;
register char *d;
register I32 tmp;
@@ -1243,7 +1245,8 @@ yylex()
return PRIVATEREF;
}
- if (!strchr(tokenbuf,':') && (tmp = pad_findmy(tokenbuf))) {
+ if (!strchr(tokenbuf,':')
+ && (tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
if (last_lop_op == OP_SORT &&
tokenbuf[0] == '$' &&
(tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
@@ -4606,6 +4609,7 @@ void
hoistmust(pm)
register PMOP *pm;
{
+ dTHR;
if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
(!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
) {
@@ -4647,7 +4651,7 @@ scan_trans(start)
char *start;
{
register char* s;
- OP *op;
+ OP *o;
short *tbl;
I32 squash;
I32 delete;
@@ -4677,7 +4681,7 @@ char *start;
}
New(803,tbl,256,short);
- op = newPVOP(OP_TRANS, 0, (char*)tbl);
+ o = newPVOP(OP_TRANS, 0, (char*)tbl);
complement = delete = squash = 0;
while (*s == 'c' || *s == 'd' || *s == 's') {
@@ -4689,9 +4693,9 @@ char *start;
squash = OPpTRANS_SQUASH;
s++;
}
- op->op_private = delete|squash|complement;
+ o->op_private = delete|squash|complement;
- lex_op = op;
+ lex_op = o;
yylval.ival = OP_TRANS;
return s;
}
@@ -4700,6 +4704,7 @@ static char *
scan_heredoc(s)
register char *s;
{
+ dTHR;
SV *herewas;
I32 op_type = OP_SCALAR;
I32 len;
@@ -4856,10 +4861,10 @@ char *start;
(void)strcpy(d,"ARGV");
if (*d == '$') {
I32 tmp;
- if (tmp = pad_findmy(d)) {
- OP *op = newOP(OP_PADSV, 0);
- op->op_targ = tmp;
- lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, op));
+ if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
+ OP *o = newOP(OP_PADSV, 0);
+ o->op_targ = tmp;
+ lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, o));
}
else {
GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
@@ -4883,6 +4888,7 @@ static char *
scan_str(start)
char *start;
{
+ dTHR;
SV *sv;
char *tmps;
register char *s = start;
@@ -5108,6 +5114,7 @@ static char *
scan_formline(s)
register char *s;
{
+ dTHR;
register char *eol;
register char *t;
SV *stuff = newSVpv("",0);
@@ -5188,6 +5195,7 @@ start_subparse(is_format, flags)
I32 is_format;
U32 flags;
{
+ dTHR;
I32 oldsavestack_ix = savestack_ix;
CV* outsidecv = compcv;
AV* comppadlist;
@@ -5214,6 +5222,9 @@ U32 flags;
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);
@@ -5227,6 +5238,13 @@ U32 flags;
CvPADLIST(compcv) = comppadlist;
CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv);
+#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 */
return oldsavestack_ix;
}
@@ -5235,6 +5253,7 @@ int
yywarn(s)
char *s;
{
+ dTHR;
--error_count;
in_eval |= 2;
yyerror(s);
@@ -5246,6 +5265,7 @@ int
yyerror(s)
char *s;
{
+ dTHR;
char *where = NULL;
char *context = NULL;
int contlen = -1;
diff --git a/util.c b/util.c
index fc245836d0..0387332e60 100644
--- a/util.c
+++ b/util.c
@@ -1162,6 +1162,7 @@ die(pat, va_alist)
va_dcl
#endif
{
+ dTHR;
va_list args;
char *message;
I32 oldrunlevel = runlevel;
@@ -1229,6 +1230,7 @@ croak(pat, va_alist)
va_dcl
#endif
{
+ dTHR;
va_list args;
char *message;
HV *stash;
@@ -1242,6 +1244,9 @@ croak(pat, va_alist)
#endif
message = mess(pat, &args);
va_end(args);
+#ifdef USE_THREADS
+ DEBUG_L(fprintf(stderr, "croak: 0x%lx %s", (unsigned long) thr, message));
+#endif /* USE_THREADS */
if (diehook) {
/* sv_2cv might call croak() */
SV *olddiehook = diehook;
@@ -1263,6 +1268,7 @@ croak(pat, va_alist)
XPUSHs(msg);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
+<<<<
LEAVE;
}
@@ -1302,6 +1308,7 @@ warn(pat,va_alist)
if (warnhook) {
/* sv_2cv might call warn() */
+ dTHR;
SV *oldwarnhook = warnhook;
ENTER;
SAVESPTR(warnhook);
@@ -2285,6 +2292,56 @@ I32 *retlen;
return retval;
}
+#ifdef USE_THREADS
+#ifdef OLD_PTHREADS_API
+struct thread *
+getTHR _((void))
+{
+ pthread_addr_t t;
+
+ if (pthread_getspecific(thr_key, &t))
+ croak("panic: pthread_getspecific");
+ return (struct thread *) t;
+}
+#endif /* OLD_PTHREADS_API */
+
+MAGIC *
+condpair_magic(sv)
+SV *sv;
+{
+ MAGIC *mg;
+
+ SvUPGRADE(sv, SVt_PVMG);
+ mg = mg_find(sv, 'm');
+ if (!mg) {
+ condpair_t *cp;
+
+ New(53, cp, 1, condpair_t);
+ MUTEX_INIT(&cp->mutex);
+ COND_INIT(&cp->owner_cond);
+ COND_INIT(&cp->cond);
+ cp->owner = 0;
+ MUTEX_LOCK(&sv_mutex);
+ mg = mg_find(sv, 'm');
+ if (mg) {
+ /* someone else beat us to initialising it */
+ MUTEX_UNLOCK(&sv_mutex);
+ MUTEX_DESTROY(&cp->mutex);
+ COND_DESTROY(&cp->owner_cond);
+ COND_DESTROY(&cp->cond);
+ Safefree(cp);
+ }
+ else {
+ sv_magic(sv, Nullsv, 'm', 0, 0);
+ mg = SvMAGIC(sv);
+ mg->mg_ptr = (char *)cp;
+ mg->mg_len = sizeof(cp);
+ MUTEX_UNLOCK(&sv_mutex);
+ }
+ }
+ return mg;
+}
+#endif /* USE_THREADS */
#ifdef HUGE_VAL
/*
View Lorry Controller Status