Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups.
authorMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Fri, 28 Mar 1997 18:40:44 +0000 (18:40 +0000)
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Fri, 28 Mar 1997 18:40:44 +0000 (18:40 +0000)
p4raw-id: //depot/thrperl@4

32 files changed:
XSUB.h
av.c
cv.h
deb.c
doio.c
doop.c
dump.c
global.sym
gv.c
hv.c
malloc.c
mg.c
op.c
op.h
opcode.h
opcode.pl
perl.c
perl.h
pp.h
pp_ctl.c
pp_hot.c
pp_sys.c
proto.h
regcomp.c
regexec.c
run.c
scope.c
sv.c
sv.h
thread.h [new file with mode: 0644]
toke.c
util.c

diff --git a/XSUB.h b/XSUB.h
index af452ea..0bfb985 100644 (file)
--- 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 b27ec76..5c240c7 100644 (file)
--- 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);
+       }
     }
     AvREAL_on(av);
 }
@@ -41,6 +43,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;
@@ -131,6 +134,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;
@@ -196,6 +200,7 @@ SV *val;
     ary = AvARRAY(av);
     if (AvFILL(av) < key) {
        if (!AvREAL(av)) {
+           dTHR;
            if (av == stack && key > stack_sp - stack_base)
                stack_sp = stack_base + key;    /* XPUSH in disguise */
            do
diff --git a/cv.h b/cv.h
index b08cf5c..91b9d44 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -26,6 +26,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;
 };
 
@@ -41,6 +46,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 f518b19..729c47e 100644 (file)
--- 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
+    fprintf(stderr,"0x%lx (%s:%ld)\t",
+       (unsigned long) thr,
+       SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+       (long)curcop->cop_line);
+#else
     fprintf(stderr,"(%s:%ld)\t",
        SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
        (long)curcop->cop_line);
+#endif /* USE_THREADS */
     for (i=0; i<dlevel; i++)
        fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
     fprintf(stderr,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
+    fprintf(stderr,"0x%lx (%s:%ld)\t",
+       (unsigned long) thr,
+       SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+       (long)curcop->cop_line);
+#else
     fprintf(stderr,"(%s:%ld)\t",
        SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
        (long)curcop->cop_line);
+#endif /* USE_THREADS */
     for (i=0; i<dlevel; i++)
        fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
 
@@ -82,6 +98,7 @@ deb_growlevel()
 I32
 debstackptrs()
 {
+    dTHR;
     fprintf(stderr, "%8lx %8lx %8ld %8ld %8ld\n",
        (unsigned long)stack, (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
+    fprintf(stderr, i ? "0x%lx    =>  ...  " : "0x%lx    =>  ",
+           (unsigned long) thr);
+#else
     fprintf(stderr, i ? "    =>  ...  " : "    =>  ");
+#endif /* USE_THREADS */
     if (stack_base[0] != &sv_undef || stack_sp < stack_base)
        fprintf(stderr, " [STACK UNDERFLOW!!!]\n");
     do {
diff --git a/doio.c b/doio.c
index f28da95..55c4243 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -353,6 +353,7 @@ register GV *gv;
     }
     filemode = 0;
     while (av_len(GvAV(gv)) >= 0) {
+       dTHR;
        STRLEN len;
        sv = av_shift(GvAV(gv));
        SAVEFREESV(sv);
@@ -587,6 +588,7 @@ bool
 do_eof(gv)
 GV *gv;
 {
+    dTHR;
     register IO *io;
     int ch;
 
@@ -918,6 +920,7 @@ register SV **sp;
     char *tmps;
 
     if (sp > mark) {
+       dTHR;
        New(401,Argv, sp - mark + 1, char*);
        a = Argv;
        while (++mark <= sp) {
@@ -1048,6 +1051,7 @@ I32 type;
 register SV **mark;
 register SV **sp;
 {
+    dTHR;
     register I32 val;
     register I32 val2;
     register I32 tot = 0;
@@ -1293,6 +1297,7 @@ I32 optype;
 SV **mark;
 SV **sp;
 {
+    dTHR;
     key_t key;
     I32 n, flags;
 
@@ -1328,6 +1333,7 @@ I32 optype;
 SV **mark;
 SV **sp;
 {
+    dTHR;
     SV *astr;
     char *a;
     I32 id, n, cmd, infosize, getinfo;
@@ -1430,6 +1436,7 @@ SV **mark;
 SV **sp;
 {
 #ifdef HAS_MSG
+    dTHR;
     SV *mstr;
     char *mbuf;
     I32 id, msize, flags;
@@ -1454,6 +1461,7 @@ SV **mark;
 SV **sp;
 {
 #ifdef HAS_MSG
+    dTHR;
     SV *mstr;
     char *mbuf;
     long mtype;
@@ -1492,6 +1500,7 @@ SV **mark;
 SV **sp;
 {
 #ifdef HAS_SEM
+    dTHR;
     SV *opstr;
     char *opbuf;
     I32 id;
@@ -1519,6 +1528,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 c906db7..5b76367 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -31,6 +31,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 19300e1..df3de9b 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -27,6 +27,7 @@ static void dump();
 void
 dump_all()
 {
+    dTHR;
 #ifdef HAS_SETLINEBUF
     setlinebuf(stderr);
 #else
@@ -41,6 +42,7 @@ void
 dump_packsubs(stash)
 HV* stash;
 {
+    dTHR;
     I32        i;
     HE *entry;
 
@@ -100,115 +102,115 @@ dump_eval()
 }
 
 void
-dump_op(op)
-register OP *op;
+dump_op(o)
+register OP *o;
 {
     SV *tmpsv;
 
     dump("{\n");
-    if (op->op_seq)
-       fprintf(stderr, "%-4d", op->op_seq);
+    if (o->op_seq)
+       fprintf(stderr, "%-4d", o->op_seq);
     else
        fprintf(stderr, "    ");
-    dump("TYPE = %s  ===> ", op_name[op->op_type]);
-    if (op->op_next) {
-       if (op->op_seq)
-           fprintf(stderr, "%d\n", op->op_next->op_seq);
+    dump("TYPE = %s  ===> ", op_name[o->op_type]);
+    if (o->op_next) {
+       if (o->op_seq)
+           fprintf(stderr, "%d\n", o->op_next->op_seq);
        else
-           fprintf(stderr, "(%d)\n", op->op_next->op_seq);
+           fprintf(stderr, "(%d)\n", o->op_next->op_seq);
     }
     else
        fprintf(stderr, "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) {
        *buf = '\0';
-       if (op->op_flags & OPf_KNOW) {
-           if (op->op_flags & OPf_LIST)
+       if (o->op_flags & OPf_KNOW) {
+           if (o->op_flags & OPf_LIST)
                (void)strcat(buf,"LIST,");
            else
                (void)strcat(buf,"SCALAR,");
        }
        else
            (void)strcat(buf,"UNKNOWN,");
-       if (op->op_flags & OPf_KIDS)
+       if (o->op_flags & OPf_KIDS)
            (void)strcat(buf,"KIDS,");
-       if (op->op_flags & OPf_PARENS)
+       if (o->op_flags & OPf_PARENS)
            (void)strcat(buf,"PARENS,");
-       if (op->op_flags & OPf_STACKED)
+       if (o->op_flags & OPf_STACKED)
            (void)strcat(buf,"STACKED,");
-       if (op->op_flags & OPf_REF)
+       if (o->op_flags & OPf_REF)
            (void)strcat(buf,"REF,");
-       if (op->op_flags & OPf_MOD)
+       if (o->op_flags & OPf_MOD)
            (void)strcat(buf,"MOD,");
-       if (op->op_flags & OPf_SPECIAL)
+       if (o->op_flags & OPf_SPECIAL)
            (void)strcat(buf,"SPECIAL,");
        if (*buf)
            buf[strlen(buf)-1] = '\0';
        dump("FLAGS = (%s)\n",buf);
     }
-    if (op->op_private) {
+    if (o->op_private) {
        *buf = '\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)
                (void)strcat(buf,"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)
                (void)strcat(buf,"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)
                (void)strcat(buf,"SQUASH,");
-           if (op->op_private & OPpTRANS_DELETE)
+           if (o->op_private & OPpTRANS_DELETE)
                (void)strcat(buf,"DELETE,");
-           if (op->op_private & OPpTRANS_COMPLEMENT)
+           if (o->op_private & OPpTRANS_COMPLEMENT)
                (void)strcat(buf,"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)
                (void)strcat(buf,"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_private & OPpENTERSUB_AMPER)
+           if (o->op_private & OPpENTERSUB_AMPER)
                (void)strcat(buf,"AMPER,");
-           if (op->op_private & OPpENTERSUB_DB)
+           if (o->op_private & OPpENTERSUB_DB)
                (void)strcat(buf,"DB,");
-           if (op->op_private & OPpDEREF_AV)
+           if (o->op_private & OPpDEREF_AV)
                (void)strcat(buf,"AV,");
-           if (op->op_private & OPpDEREF_HV)
+           if (o->op_private & OPpDEREF_HV)
                (void)strcat(buf,"HV,");
-           if (op->op_private & HINT_STRICT_REFS)
+           if (o->op_private & HINT_STRICT_REFS)
                (void)strcat(buf,"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)
                (void)strcat(buf,"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)
                (void)strcat(buf,"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)
                (void)strcat(buf,"LINENUM,");
        }
-       if (op->op_flags & OPf_MOD && op->op_private & OPpLVAL_INTRO)
+       if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
            (void)strcat(buf,"INTRO,");
        if (*buf) {
            buf[strlen(buf)-1] = '\0';
@@ -216,14 +218,14 @@ register OP *op;
        }
     }
 
-    switch (op->op_type) {
+    switch (o->op_type) {
     case OP_GVSV:
     case OP_GV:
-       if (cGVOP->op_gv) {
+       if (cGVOPo->op_gv) {
            ENTER;
            tmpsv = NEWSV(0,0);
            SAVEFREESV(tmpsv);
-           gv_fullname(tmpsv,cGVOP->op_gv);
+           gv_fullname(tmpsv,cGVOPo->op_gv);
            dump("GV = %s\n", SvPV(tmpsv, na));
            LEAVE;
        }
@@ -231,41 +233,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)
-           fprintf(stderr, "%d\n", cLOOP->op_redoop->op_seq);
+       if (cLOOPo->op_redoop)
+           fprintf(stderr, "%d\n", cLOOPo->op_redoop->op_seq);
        else
            fprintf(stderr, "DONE\n");
        dump("NEXT ===> ");
-       if (cLOOP->op_nextop)
-           fprintf(stderr, "%d\n", cLOOP->op_nextop->op_seq);
+       if (cLOOPo->op_nextop)
+           fprintf(stderr, "%d\n", cLOOPo->op_nextop->op_seq);
        else
            fprintf(stderr, "DONE\n");
        dump("LAST ===> ");
-       if (cLOOP->op_lastop)
-           fprintf(stderr, "%d\n", cLOOP->op_lastop->op_seq);
+       if (cLOOPo->op_lastop)
+           fprintf(stderr, "%d\n", cLOOPo->op_lastop->op_seq);
        else
            fprintf(stderr, "DONE\n");
        break;
     case OP_COND_EXPR:
        dump("TRUE ===> ");
-       if (cCONDOP->op_true)
-           fprintf(stderr, "%d\n", cCONDOP->op_true->op_seq);
+       if (cCONDOPo->op_true)
+           fprintf(stderr, "%d\n", cCONDOPo->op_true->op_seq);
        else
            fprintf(stderr, "DONE\n");
        dump("FALSE ===> ");
-       if (cCONDOP->op_false)
-           fprintf(stderr, "%d\n", cCONDOP->op_false->op_seq);
+       if (cCONDOPo->op_false)
+           fprintf(stderr, "%d\n", cCONDOPo->op_false->op_seq);
        else
            fprintf(stderr, "DONE\n");
        break;
@@ -274,22 +276,22 @@ register OP *op;
     case OP_OR:
     case OP_AND:
        dump("OTHER ===> ");
-       if (cLOGOP->op_other)
-           fprintf(stderr, "%d\n", cLOGOP->op_other->op_seq);
+       if (cLOGOPo->op_other)
+           fprintf(stderr, "%d\n", cLOGOPo->op_other->op_seq);
        else
            fprintf(stderr, "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--;
index 70d07c0..ea39192 100644 (file)
@@ -436,6 +436,7 @@ hv_store
 hv_undef
 ibcmp
 ingroup
+init_stacks
 instr
 intuit_more
 invert
diff --git a/gv.c b/gv.c
index dc6d2e5..7f73664 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -261,6 +261,7 @@ char* name;
                     sv_catpvn(tmpstr, "::ISA", 5);
                     gv  = gv_fetchpv(SvPV(tmpstr,na),TRUE,SVt_PVGV);
                      if (gv) {
+                       dTHR;
                        GvAV(gv) = (AV*)SvREFCNT_inc(av);
                        /* ... and re-try lookup */
                        gv = gv_fetchmeth(stash, name, nend - name, 0);
@@ -331,6 +332,7 @@ char *nambeg;
 I32 add;
 I32 sv_type;
 {
+    dTHR;
     register char *name = nambeg;
     register GV *gv = 0;
     GV**gvp;
@@ -695,6 +697,7 @@ GV *gv;
 IO *
 newIO()
 {
+    dTHR;
     IO *io;
     GV *iogv;
 
@@ -711,6 +714,7 @@ void
 gv_check(stash)
 HV* stash;
 {
+    dTHR;
     register HE *entry;
     register I32 i;
     register GV *gv;
@@ -824,6 +828,7 @@ bool
 Gv_AMupdate(stash)
 HV* stash;
 {
+  dTHR;  
   GV** gvp;
   HV* hv;
   GV* gv;
@@ -935,6 +940,7 @@ SV* right;
 int method;
 int flags; 
 {
+  dTHR;
   MAGIC *mg; 
   CV *cv; 
   CV **cvp=NULL, **ocvp=NULL;
@@ -1120,6 +1126,7 @@ int flags;
        || inc_dec_ass) RvDEEPCP(left);
   }
   {
+    dTHR;
     dSP;
     BINOP myop;
     SV* res;
@@ -1133,7 +1140,7 @@ int flags;
     SAVESPTR(op);
     op = (OP *) &myop;
     PUTBACK;
-    pp_pushmark();
+    pp_pushmark(ARGS);
 
     EXTEND(sp, notfound + 5);
     PUSHs(lr>0? right: left);
@@ -1145,7 +1152,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 d9cbe52..a3dc657 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -74,6 +74,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;
@@ -278,6 +279,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'));
index 581cbd3..7c23adb 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -126,6 +126,7 @@ malloc(nbytes)
 #endif
 #endif /* safemalloc */
 
+       MUTEX_LOCK(&malloc_mutex);
        /*
         * Convert amount of memory requested into
         * closest block size stored in hash buckets
@@ -145,6 +146,7 @@ malloc(nbytes)
        if (nextf[bucket] == NULL)    
                morecore(bucket);
        if ((p = (union overhead *)nextf[bucket]) == NULL) {
+               MUTEX_UNLOCK(&malloc_mutex);
 #ifdef safemalloc
                if (!nomemok) {
                    fputs("Out of memory!\n", stderr);
@@ -182,6 +184,7 @@ malloc(nbytes)
        p->ov_rmagic = RMAGIC;
        *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
 #endif
+       MUTEX_UNLOCK(&malloc_mutex);
        return ((Malloc_t)(p + 1));
 }
 
@@ -281,6 +284,7 @@ free(mp)
                return;                         /* sanity */
        }
 #endif
+       MUTEX_LOCK(&malloc_mutex);
 #ifdef RCHECK
        ASSERT(op->ov_rmagic == RMAGIC);
        if (op->ov_index <= 13)
@@ -294,6 +298,7 @@ free(mp)
 #ifdef DEBUGGING_MSTATS
        nmalloc[size]--;
 #endif
+       MUTEX_UNLOCK(&malloc_mutex);
 }
 
 /*
@@ -340,6 +345,7 @@ realloc(mp, nbytes)
 #endif
 #endif /* safemalloc */
 
+       MUTEX_LOCK(&malloc_mutex);
        op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
        if (op->ov_magic == MAGIC) {
                was_alloced++;
@@ -383,8 +389,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 5e649bb..a395cc2 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -636,6 +636,7 @@ magic_setsig(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     register char *s;
     I32 i;
     SV** svp;
@@ -726,6 +727,7 @@ SV* sv;
 MAGIC* mg;
 char *meth;
 {
+    dTHR;
     dSP;
 
     ENTER;
@@ -763,6 +765,7 @@ magic_setpack(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     dSP;
 
     PUSHMARK(sp);
@@ -792,6 +795,7 @@ int magic_wipepack(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     dSP;
 
     PUSHMARK(sp);
@@ -809,6 +813,7 @@ SV* sv;
 MAGIC* mg;
 SV* key;
 {
+    dTHR;
     dSP;
     char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
 
@@ -842,6 +847,7 @@ magic_setdbline(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     OP *o;
     I32 i;
     GV* gv;
@@ -996,6 +1002,7 @@ magic_settaint(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     if (localizing) {
        if (localizing == 1)
            mg->mg_len <<= 1;
@@ -1055,6 +1062,7 @@ magic_set(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     register char *s;
     I32 i;
     STRLEN len;
@@ -1356,6 +1364,7 @@ Signal_t
 sighandler(sig)
 int sig;
 {
+    dTHR;
     dSP;
     GV *gv;
     HV *st;
diff --git a/op.c b/op.c
index d56ed9a..ca6d445 100644 (file)
--- a/op.c
+++ b/op.c
  * In the following definition, the ", (OP *) op" 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]) \
-     ? (croak("%s trapped by operation mask", op_desc[type]), (OP*)op) \
-     : (*check[type])((OP*)op))
+     ? (croak("%s trapped by operation mask", op_desc[type]), (OP*)o) \
+     : (*check[type])((OP*)o))
 #else
-#define CHECKOP(type,op) (*check[type])(op)
+#define CHECKOP(type,o) (*check[type])(o)
 #endif /* USE_OP_MASK */
 
-static I32 list_assignment _((OP *op));
-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 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 I32 list_assignment _((OP *o));
+static void bad_type _((I32 n, char *t, char *name, OP *kid));
+static OP *modkids _((OP *o, I32 type));
+static OP *no_fh_allowed _((OP *o));
+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, I32 seq,
        CV* startcv, I32 cx_ix));
 
@@ -54,36 +54,36 @@ CV* cv;
 }
 
 static OP *
-no_fh_allowed(op)
-OP *op;
+no_fh_allowed(o)
+OP *o;
 {
     sprintf(tokenbuf,"Missing comma after first argument to %s function",
-       op_desc[op->op_type]);
+       op_desc[o->op_type]);
     yyerror(tokenbuf);
-    return op;
+    return o;
 }
 
 static OP *
-too_few_arguments(op, name)
-OP* op;
+too_few_arguments(o, name)
+OP* o;
 char* name;
 {
     sprintf(tokenbuf,"Not enough arguments for %s", name);
     yyerror(tokenbuf);
-    return op;
+    return o;
 }
 
 static OP *
-too_many_arguments(op, name)
-OP *op;
+too_many_arguments(o, name)
+OP *o;
 char* name;
 {
     sprintf(tokenbuf,"Too many arguments for %s", name);
     yyerror(tokenbuf);
-    return op;
+    return o;
 }
 
-static OP *
+static void
 bad_type(n, t, name, kid)
 I32 n;
 char *t;
@@ -93,14 +93,13 @@ OP *kid;
     sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)",
        (int) n, name, t, op_desc[kid->op_type]);
     yyerror(tokenbuf);
-    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) {
        sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]);
        yyerror(tokenbuf);
@@ -116,6 +115,7 @@ PADOFFSET
 pad_allocmy(name)
 char *name;
 {
+    dTHR;
     PADOFFSET off;
     SV *sv;
 
@@ -154,6 +154,7 @@ I32 cx_ix;
 pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
 #endif
 {
+    dTHR;
     CV *cv;
     I32 off;
     SV *sv;
@@ -237,11 +238,25 @@ PADOFFSET
 pad_findmy(name)
 char *name;
 {
+    dTHR;
     I32 off;
     SV *sv;
     SV **svp = AvARRAY(comppad_name);
     I32 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]) &&
@@ -257,9 +272,9 @@ char *name;
     /* See if it's in a nested scope */
     off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix);
     if (off)
-       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
@@ -287,6 +302,7 @@ pad_alloc(optype,tmptype)
 I32 optype;
 U32 tmptype;
 {
+    dTHR;
     SV *sv;
     I32 retval;
 
@@ -308,7 +324,13 @@ U32 tmptype;
     }
     SvFLAGS(sv) |= tmptype;
     curpad = AvARRAY(comppad);
+#ifdef USE_THREADS
+    DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx alloc %ld for %s\n",
+                   (unsigned long) thr, (unsigned long) curpad,
+                   (long) retval, op_name[optype]));
+#else
     DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype]));
+#endif /* USE_THREADS */
     return (PADOFFSET)retval;
 }
 
@@ -320,9 +342,15 @@ PADOFFSET po;
 pad_sv(PADOFFSET po)
 #endif /* CAN_PROTOTYPE */
 {
+    dTHR;
+#ifdef USE_THREADS
+    DEBUG_X(fprintf(stderr, "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(fprintf(stderr, "Pad sv %d\n", po));
+#endif /* USE_THREADS */
     return curpad[po];         /* eventually we'll turn this into a macro */
 }
 
@@ -334,13 +362,19 @@ 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");
+#ifdef USE_THREADS
+    DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx free %d\n",
+                   (unsigned long) thr, (unsigned long) curpad, po));
+#else
     DEBUG_X(fprintf(stderr, "Pad free %d\n", po));
+#endif /* USE_THREADS */
     if (curpad[po] && curpad[po] != &sv_undef)
        SvPADTMP_off(curpad[po]);
     if ((I32)po < padix)
@@ -355,11 +389,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");
+#ifdef USE_THREADS
+    DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx swipe %d\n",
+                   (unsigned long) thr, (unsigned long) curpad, po));
+#else
     DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po));
+#endif /* USE_THREADS */
     SvPADTMP_off(curpad[po]);
     curpad[po] = NEWSV(1107,0);
     SvPADTMP_on(curpad[po]);
@@ -370,11 +410,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(fprintf(stderr, "0x%lx Pad 0x%lx reset\n",
+                   (unsigned long) thr, (unsigned long) curpad));
+#else
     DEBUG_X(fprintf(stderr, "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] && curpad[po] != &sv_undef)
@@ -388,76 +434,76 @@ pad_reset()
 /* Destructor */
 
 void
-op_free(op)
-OP *op;
+op_free(o)
+OP *o;
 {
     register OP *kid, *nextkid;
 
-    if (!op)
+    if (!o)
        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;
     case OP_GVSV:
     case OP_GV:
-       SvREFCNT_dec(cGVOP->op_gv);
+       SvREFCNT_dec(cGVOPo->op_gv);
        break;
     case OP_NEXTSTATE:
     case OP_DBSTATE:
-       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;
     default:
        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 */
@@ -465,48 +511,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)
@@ -514,36 +560,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_KNOW) || error_count)
-       return op;
+    if (!o || (o->op_flags & OPf_KNOW) || error_count)
+       return o;
 
-    op->op_flags &= ~OPf_LIST;
-    op->op_flags |= OPf_KNOW;
+    o->op_flags &= ~OPf_LIST;
+    o->op_flags |= OPf_KNOW;
 
-    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 @_");
        }
@@ -552,19 +598,19 @@ 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:
-       scalar(cLISTOP->op_first);
+       scalar(cLISTOPo->op_first);
        /* FALL THROUGH */
     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
@@ -573,29 +619,29 @@ 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;
 
-    if (!op || error_count)
-       return op;
-    if (op->op_flags & OPf_LIST)
-       return op;
+    if (!o || error_count)
+       return o;
+    if (o->op_flags & OPf_LIST)
+       return o;
 
-    op->op_flags |= OPf_KNOW;
+    o->op_flags |= OPf_KNOW;
 
-    switch (op->op_type) {
+    switch (o->op_type) {
     default:
-       if (!(opargs[op->op_type] & OA_FOLDCONST))
+       if (!(opargs[o->op_type] & OA_FOLDCONST))
            break;
-       if (op->op_flags & OPf_STACKED)
+       if (o->op_flags & OPf_STACKED)
            break;
        /* FALL THROUGH */
     case OP_GVSV:
@@ -668,26 +714,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))
@@ -699,121 +745,121 @@ 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_REPEAT:
-       scalarvoid(cBINOP->op_first);
-       useless = op_desc[op->op_type];
+       scalarvoid(cBINOPo->op_first);
+       useless = op_desc[o->op_type];
        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;
     case OP_ENTERTRY:
     case OP_ENTER:
     case OP_SCALAR:
-       if (!(op->op_flags & OPf_KIDS))
+       if (!(o->op_flags & OPf_KIDS))
            break;
     case OP_SCOPE:
     case OP_LEAVE:
     case OP_LEAVETRY:
     case OP_LEAVELOOP:
-       op->op_private |= OPpLEAVE_VOID;
+       o->op_private |= OPpLEAVE_VOID;
     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_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 @_");
        }
        break;
     case OP_DELETE:
-       op->op_private |= OPpLEAVE_VOID;
+       o->op_private |= OPpLEAVE_VOID;
        break;
     }
     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_KNOW) || error_count)
-       return op;
+    if (!o || (o->op_flags & OPf_KNOW) || error_count)
+       return o;
 
-    op->op_flags |= (OPf_KNOW | OPf_LIST);
+    o->op_flags |= (OPf_KNOW | OPf_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:
-       list(cLISTOP->op_first);
+       list(cLISTOPo->op_first);
        /* FALL THROUGH */
     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
@@ -822,67 +868,68 @@ OP *op;
        curcop = &compiling;
        break;
     }
-    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;
     char mtype;
 
-    if (!op || error_count)
-       return op;
+    if (!o || error_count)
+       return o;
 
-    switch (op->op_type) {
+    switch (o->op_type) {
     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);
@@ -899,11 +946,11 @@ I32 type;
        break;
     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 */
@@ -913,10 +960,10 @@ I32 type;
        if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
            break;
        sprintf(tokenbuf, "Can't modify %s in %s",
-           op_desc[op->op_type],
+           op_desc[o->op_type],
            type ? op_desc[type] : "local");
        yyerror(tokenbuf);
-       return op;
+       return o;
 
     case OP_PREINC:
     case OP_PREDEC:
@@ -938,25 +985,25 @@ 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:
-       ref(cUNOP->op_first, op->op_type);
+       ref(cUNOPo->op_first, o->op_type);
        /* FALL THROUGH */
     case OP_AASSIGN:
     case OP_ASLICE:
@@ -968,9 +1015,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_UNDEF:
     case OP_GV:
@@ -988,7 +1035,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:
@@ -1003,129 +1050,129 @@ I32 type;
     case OP_SUBSTR:
        mtype = 'x';
       makelv:
-       pad_free(op->op_targ);
-       op->op_targ = pad_alloc(op->op_type, SVs_PADMY);
-       sv = PAD_SV(op->op_targ);
+       pad_free(o->op_targ);
+       o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
+       sv = PAD_SV(o->op_targ);
        sv_upgrade(sv, SVt_PVLV);
        sv_magic(sv, Nullsv, mtype, Nullch, 0);
-       curpad[op->op_targ] = sv;
-       if (op->op_flags & OPf_KIDS)
-           mod(cBINOP->op_first->op_sibling, type);
+       curpad[o->op_targ] = sv;
+       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);
        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;
 }
 
 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_RV2AV || type == OP_RV2HV) {
-           op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
-           op->op_flags |= OPf_MOD;
+           o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
+           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_RV2AV || type == OP_RV2HV) {
-           op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
-           op->op_flags |= OPf_MOD;
+           o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
+           o->op_flags |= OPf_MOD;
        }
        break;
 
@@ -1133,30 +1180,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 &&
@@ -1164,13 +1211,13 @@ OP *op;
             type != OP_PADHV &&
             type != OP_PUSHMARK)
     {
-       sprintf(tokenbuf, "Can't declare %s in my", op_desc[op->op_type]);
+       sprintf(tokenbuf, "Can't declare %s in my", op_desc[o->op_type]);
        yyerror(tokenbuf);
-       return op;
+       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 *
@@ -1188,7 +1235,7 @@ I32 type;
 OP *left;
 OP *right;
 {
-    OP *op;
+    OP *o;
 
     if (right->op_type == OP_MATCH ||
        right->op_type == OP_SUBST ||
@@ -1197,12 +1244,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,
@@ -1210,13 +1257,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 *
@@ -1250,6 +1297,7 @@ OP *o;
 int
 block_start()
 {
+    dTHR;
     int retval = savestack_ix;
     comppad_name_fill = AvFILL(comppad_name);
     SAVEINT(min_intro_pending);
@@ -1270,6 +1318,7 @@ int line;
 int floor;
 OP* seq;
 {
+    dTHR;
     int needblockscope = hints & HINT_BLOCK_SCOPE;
     OP* retval = scalarseq(seq);
     if (copline > (line_t)line)
@@ -1283,21 +1332,22 @@ OP* seq;
 }
 
 void
-newPROG(op)
-OP *op;
+newPROG(o)
+OP *o;
 {
+    dTHR;
     if (in_eval) {
-       eval_root = newUNOP(OP_LEAVEEVAL, 0, op);
+       eval_root = newUNOP(OP_LEAVEEVAL, 0, o);
        eval_start = linklist(eval_root);
        eval_root->op_next = 0;
        peep(eval_start);
     }
     else {
-       if (!op) {
+       if (!o) {
            main_start = 0;
            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;
@@ -1347,6 +1397,7 @@ OP *
 fold_constants(o)
 register OP *o;
 {
+    dTHR;
     register OP *curop;
     I32 type = o->op_type;
     SV *sv;
@@ -1445,6 +1496,7 @@ OP *
 gen_constant_list(o)
 register OP *o;
 {
+    dTHR;
     register OP *curop;
     I32 oldtmps_floor = tmps_floor;
 
@@ -1454,10 +1506,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;
@@ -1470,38 +1522,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_KNOW|OPf_LIST);
+       o->op_flags &= ~(OPf_KNOW|OPf_LIST);
 
     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 */
@@ -1601,13 +1653,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 *
@@ -1654,19 +1706,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->op_next = op;
-    op->op_private = 0 + (flags >> 8);
+    OP *o;
+    Newz(1101, o, 1, OP);
+    o->op_type = type;
+    o->op_ppaddr = ppaddr[type];
+    o->op_flags = flags;
+
+    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 *
@@ -1732,8 +1784,8 @@ OP* last;
 }
 
 OP *
-pmtrans(op, expr, repl)
-OP *op;
+pmtrans(o, expr, repl)
+OP *o;
 OP *expr;
 OP *repl;
 {
@@ -1749,10 +1801,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);
@@ -1795,7 +1847,7 @@ OP *repl;
     op_free(expr);
     op_free(repl);
 
-    return op;
+    return o;
 }
 
 OP *
@@ -1803,6 +1855,7 @@ newPMOP(type, flags)
 I32 type;
 I32 flags;
 {
+    dTHR;
     PMOP *pmop;
 
     Newz(1101, pmop, 1, PMOP);
@@ -1821,24 +1874,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;
@@ -1859,7 +1912,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) {
@@ -1872,7 +1925,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) {
@@ -1914,7 +1967,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);
@@ -1923,7 +1976,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);
@@ -1964,6 +2017,7 @@ I32 type;
 I32 flags;
 GV *gv;
 {
+    dTHR;
     GVOP *gvop;
     Newz(1101, gvop, 1, GVOP);
     gvop->op_type = type;
@@ -1999,21 +2053,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_stashpv(name,TRUE);
        sv_setpvn(curstname, name, len);
-       op_free(op);
+       op_free(o);
     }
     else {
        sv_setpv(curstname,"<none>");
@@ -2083,18 +2138,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;
@@ -2103,15 +2158,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;
@@ -2124,7 +2179,7 @@ OP *left;
 I32 optype;
 OP *right;
 {
-    OP *op;
+    OP *o;
 
     if (optype) {
        if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
@@ -2149,16 +2204,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;
@@ -2190,8 +2245,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;
@@ -2201,17 +2256,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_KNOW|OPf_LIST);
                                /* "I don't know and I don't care." */
                        return right;
@@ -2228,7 +2283,7 @@ OP *right;
                }
            }
        }
-       return op;
+       return o;
     }
     if (!right)
        right = newOP(OP_UNDEF, 0);
@@ -2238,24 +2293,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;
     register COP *cop;
 
     /* Introduce my variables. */
@@ -2311,7 +2367,7 @@ OP *op;
        }
     }
 
-    return prepend_elem(OP_LINESEQ, (OP*)cop, op);
+    return prepend_elem(OP_LINESEQ, (OP*)cop, o);
 }
 
 OP *
@@ -2321,8 +2377,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));
@@ -2335,12 +2392,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) {
@@ -2382,10 +2439,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 *
@@ -2395,8 +2452,9 @@ OP* first;
 OP* true;
 OP* false;
 {
+    dTHR;
     CONDOP *condop;
-    OP *op;
+    OP *o;
 
     if (!false)
        return newLOGOP(OP_AND, 0, first, true);
@@ -2436,12 +2494,12 @@ OP* false;
 
     first->op_sibling = true;
     true->op_sibling = false;
-    op = newUNOP(OP_NULL, 0, (OP*)condop);
+    o = newUNOP(OP_NULL, 0, (OP*)condop);
 
-    true->op_next = op;
-    false->op_next = op;
+    true->op_next = o;
+    false->op_next = o;
 
-    return op;
+    return o;
 }
 
 OP *
@@ -2453,7 +2511,7 @@ OP *right;
     CONDOP *condop;
     OP *flip;
     OP *flop;
-    OP *op;
+    OP *o;
 
     Newz(1101, condop, 1, CONDOP);
 
@@ -2470,7 +2528,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;
@@ -2484,11 +2542,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 *
@@ -2498,8 +2556,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);
 
@@ -2511,20 +2570,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 *
@@ -2536,10 +2595,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)) {
@@ -2559,19 +2619,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);
@@ -2581,19 +2641,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 *
@@ -2650,9 +2710,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)
                    : "" ));
@@ -2661,19 +2722,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);
@@ -2704,6 +2780,7 @@ CV *
 cv_clone(proto)
 CV* proto;
 {
+    dTHR;
     AV* av;
     I32 ix;
     AV* protopadlist = CvPADLIST(proto);
@@ -2722,6 +2799,13 @@ CV* proto;
     sv_upgrade((SV *)cv, SVt_PVCV);
     CvCLONED_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)           = SvREFCNT_inc(CvGV(proto));
     CvSTASH(cv)                = CvSTASH(proto);
@@ -2777,20 +2861,21 @@ CV* proto;
 }
 
 CV *
-newSUB(floor,op,proto,block)
+newSUB(floor,o,proto,block)
 I32 floor;
-OP *op;
+OP *o;
 OP *proto;
 OP *block;
 {
+    dTHR;
     register CV *cv;
-    char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__";
+    char *name = o ? SvPVx(cSVOPo->op_sv, na) : "__ANON__";
     GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
     AV* av;
     char *s;
     I32 ix;
 
-    if (op)
+    if (o)
        sub_generation++;
     if (cv = GvCV(gv)) {
        if (GvCVGEN(gv))
@@ -2825,6 +2910,13 @@ OP *block;
     CvFILEGV(cv) = curcop->cop_filegv;
     CvGV(cv) = SvREFCNT_inc(gv);
     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 (proto) {
        char *p = SvPVx(((SVOP*)proto)->op_sv, na);
@@ -2840,7 +2932,7 @@ OP *block;
     }
     if (!block) {
        CvROOT(cv) = 0;
-       op_free(op);
+       op_free(o);
        copline = NOLINE;
        LEAVE_SCOPE(floor);
        return cv;
@@ -2905,10 +2997,10 @@ OP *block;
        gv_efullname(tmpstr,gv);
        hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
     }
-    op_free(op);
+    op_free(o);
     copline = NOLINE;
     LEAVE_SCOPE(floor);
-    if (!op) {
+    if (!o) {
        GvCV(gv) = 0;   /* Will remember in SVOP instead. */
        CvANON_on(cv);
     }
@@ -2936,6 +3028,7 @@ char *name;
 void (*subaddr) _((CV*));
 char *filename;
 {
+    dTHR;
     register CV *cv;
     GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
     char *s;
@@ -2968,6 +3061,13 @@ char *filename;
     GvCV(gv) = cv;
     CvGV(cv) = SvREFCNT_inc(gv);
     GvCVGEN(gv) = 0;
+#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;
     if (!name)
@@ -2995,18 +3095,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);
@@ -3036,25 +3137,25 @@ OP *block;
     CvROOT(cv)->op_next = 0;
     peep(CvSTART(cv));
     FmLINES(cv) = 0;
-    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 *
@@ -3181,23 +3282,23 @@ OP *o;
 /* Check routines. */
 
 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;
-       op = modkids(ck_fun(op), op->op_type);
-       kid = cUNOP->op_first;
+       o = modkids(ck_fun(o), o->op_type);
+       kid = cUNOPo->op_first;
        newop = kUNOP->op_first->op_sibling;
        if (newop &&
            (newop->op_sibling ||
@@ -3205,64 +3306,64 @@ 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);
-    if (op->op_flags & OPf_KIDS) {
-       OP *kid = cUNOP->op_first;
+    o = ck_fun(o);
+    if (o->op_flags & OPf_KIDS) {
+       OP *kid = cUNOPo->op_first;
        if (kid->op_type != OP_HELEM)
-           croak("%s argument is not a HASH element", op_desc[op->op_type]);
+           croak("%s argument is not a HASH element", 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;
@@ -3272,35 +3373,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 *
@@ -3314,14 +3415,15 @@ 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) {
-       int iscv = (op->op_type==OP_RV2CV)*2;
+       int iscv = (o->op_type==OP_RV2CV)*2;
        GV *gv = 0;
        kid->op_type = OP_GV;
        for (gv = 0; !gv; iscv++) {
@@ -3337,78 +3439,80 @@ 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_formline(op)
-OP *op;
+ck_formline(o)
+OP *o;
 {
-    return ck_fun(op);
+    return ck_fun(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)
        {
@@ -3448,7 +3552,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:
@@ -3466,7 +3570,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:
@@ -3507,13 +3611,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)));
     }
 
@@ -3521,68 +3625,68 @@ 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 = 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);
 
@@ -3590,105 +3694,105 @@ 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, 0);
     }
-    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;
 {
-    return modkids(ck_fun(op), op->op_type);
+    return modkids(ck_fun(o), o->op_type);
 }
 
 OP *
-ck_rfun(op)
-OP *op;
+ck_rfun(o)
+OP *o;
 {
-    return refkids(ck_fun(op), op->op_type);
+    return refkids(ck_fun(o), o->op_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)) );
 
-    return listkids(op);
+    return listkids(o);
 }
 
 OP *
-ck_match(op)
-OP *op;
+ck_match(o)
+OP *o;
 {
-    cPMOP->op_pmflags |= PMf_RUNTIME;
-    cPMOP->op_pmpermflags |= PMf_RUNTIME;
-    return op;
+    cPMOPo->op_pmflags |= PMf_RUNTIME;
+    cPMOPo->op_pmpermflags |= PMf_RUNTIME;
+    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;
@@ -3702,61 +3806,61 @@ 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,
                    gv_fetchpv((subline ? "_" : "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;
 {
-    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 */
 
@@ -3767,7 +3871,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;
 
@@ -3782,46 +3886,46 @@ 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;
@@ -3835,56 +3939,57 @@ 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;
     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 = GvCV(tmpop->op_sv);
-           if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER))
+           if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER))
                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, CvNAME(cv));
+               return too_many_arguments(o, CvNAME(cv));
            case ';':
                optional = 1;
                proto++;
@@ -3892,28 +3997,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", CvNAME(cv), o);
+               if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
+                   bad_type(arg, "block", CvNAME(cv), 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;
                }
@@ -3923,29 +4028,29 @@ OP *op;
                arg++;
                switch (*proto++) {
                case '*':
-                   if (o->op_type != OP_RV2GV)
-                       bad_type(arg, "symbol", CvNAME(cv), o);
+                   if (o2->op_type != OP_RV2GV)
+                       bad_type(arg, "symbol", CvNAME(cv), o2);
                    goto wrapref;
                case '&':
-                   if (o->op_type != OP_RV2CV)
-                       bad_type(arg, "sub", CvNAME(cv), o);
+                   if (o2->op_type != OP_RV2CV)
+                       bad_type(arg, "sub", CvNAME(cv), o2);
                    goto wrapref;
                case '$':
-                   if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV)
-                       bad_type(arg, "scalar", CvNAME(cv), o);
+                   if (o2->op_type != OP_RV2SV && o2->op_type != OP_PADSV)
+                       bad_type(arg, "scalar", CvNAME(cv), o2);
                    goto wrapref;
                case '@':
-                   if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV)
-                       bad_type(arg, "array", CvNAME(cv), o);
+                   if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
+                       bad_type(arg, "array", CvNAME(cv), o2);
                    goto wrapref;
                case '%':
-                   if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV)
-                       bad_type(arg, "hash", CvNAME(cv), o);
+                   if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
+                       bad_type(arg, "hash", CvNAME(cv), 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;
                    }
@@ -3960,38 +4065,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, CvNAME(cv));
-    return op;
+       return too_few_arguments(o, CvNAME(cv));
+    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. */
@@ -4000,6 +4105,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 304099b..879080f 100644 (file)
--- 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
@@ -206,6 +207,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)
index b13849d..1124097 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1052,378 +1052,378 @@ EXT char *op_desc[] = {
 };
 #endif
 
-OP *   ck_concat       _((OP* op));
-OP *   ck_delete       _((OP* op));
-OP *   ck_eof          _((OP* op));
-OP *   ck_eval         _((OP* op));
-OP *   ck_exec         _((OP* op));
-OP *   ck_formline     _((OP* op));
-OP *   ck_ftst         _((OP* op));
-OP *   ck_fun          _((OP* op));
-OP *   ck_glob         _((OP* op));
-OP *   ck_grep         _((OP* op));
-OP *   ck_index        _((OP* op));
-OP *   ck_lengthconst  _((OP* op));
-OP *   ck_lfun         _((OP* op));
-OP *   ck_listiob      _((OP* op));
-OP *   ck_match        _((OP* op));
-OP *   ck_null         _((OP* op));
-OP *   ck_repeat       _((OP* op));
-OP *   ck_require      _((OP* op));
-OP *   ck_rfun         _((OP* op));
-OP *   ck_rvconst      _((OP* op));
-OP *   ck_select       _((OP* op));
-OP *   ck_shift        _((OP* op));
-OP *   ck_sort         _((OP* op));
-OP *   ck_spair        _((OP* op));
-OP *   ck_split        _((OP* op));
-OP *   ck_subr         _((OP* op));
-OP *   ck_svconst      _((OP* op));
-OP *   ck_trunc        _((OP* op));
+OP *   ck_concat       _((OP* o));
+OP *   ck_delete       _((OP* o));
+OP *   ck_eof          _((OP* o));
+OP *   ck_eval         _((OP* o));
+OP *   ck_exec         _((OP* o));
+OP *   ck_formline     _((OP* o));
+OP *   ck_ftst         _((OP* o));
+OP *   ck_fun          _((OP* o));
+OP *   ck_glob         _((OP* o));
+OP *   ck_grep         _((OP* o));
+OP *   ck_index        _((OP* o));
+OP *   ck_lengthconst  _((OP* o));
+OP *   ck_lfun         _((OP* o));
+OP *   ck_listiob      _((OP* o));
+OP *   ck_match        _((OP* o));
+OP *   ck_null         _((OP* o));
+OP *   ck_repeat       _((OP* o));
+OP *   ck_require      _((OP* o));
+OP *   ck_rfun         _((OP* o));
+OP *   ck_rvconst      _((OP* o));
+OP *   ck_select       _((OP* o));
+OP *   ck_shift        _((OP* o));
+OP *   ck_sort         _((OP* o));
+OP *   ck_spair        _((OP* o));
+OP *   ck_split        _((OP* o));
+OP *   ck_subr         _((OP* o));
+OP *   ck_svconst      _((OP* o));
+OP *   ck_trunc        _((OP* o));
 
-OP *   pp_null         _((void));
-OP *   pp_stub         _((void));
-OP *   pp_scalar       _((void));
-OP *   pp_pushmark     _((void));
-OP *   pp_wantarray    _((void));
-OP *   pp_const        _((void));
-OP *   pp_gvsv         _((void));
-OP *   pp_gv           _((void));
-OP *   pp_gelem        _((void));
-OP *   pp_padsv        _((void));
-OP *   pp_padav        _((void));
-OP *   pp_padhv        _((void));
-OP *   pp_padany       _((void));
-OP *   pp_pushre       _((void));
-OP *   pp_rv2gv        _((void));
-OP *   pp_rv2sv        _((void));
-OP *   pp_av2arylen    _((void));
-OP *   pp_rv2cv        _((void));
-OP *   pp_anoncode     _((void));
-OP *   pp_prototype    _((void));
-OP *   pp_refgen       _((void));
-OP *   pp_srefgen      _((void));
-OP *   pp_ref          _((void));
-OP *   pp_bless        _((void));
-OP *   pp_backtick     _((void));
-OP *   pp_glob         _((void));
-OP *   pp_readline     _((void));
-OP *   pp_rcatline     _((void));
-OP *   pp_regcmaybe    _((void));
-OP *   pp_regcomp      _((void));
-OP *   pp_match        _((void));
-OP *   pp_subst        _((void));
-OP *   pp_substcont    _((void));
-OP *   pp_trans        _((void));
-OP *   pp_sassign      _((void));
-OP *   pp_aassign      _((void));
-OP *   pp_chop         _((void));
-OP *   pp_schop        _((void));
-OP *   pp_chomp        _((void));
-OP *   pp_schomp       _((void));
-OP *   pp_defined      _((void));
-OP *   pp_undef        _((void));
-OP *   pp_study        _((void));
-OP *   pp_pos          _((void));
-OP *   pp_preinc       _((void));
-OP *   pp_i_preinc     _((void));
-OP *   pp_predec       _((void));
-OP *   pp_i_predec     _((void));
-OP *   pp_postinc      _((void));
-OP *   pp_i_postinc    _((void));
-OP *   pp_postdec      _((void));
-OP *   pp_i_postdec    _((void));
-OP *   pp_pow          _((void));
-OP *   pp_multiply     _((void));
-OP *   pp_i_multiply   _((void));
-OP *   pp_divide       _((void));
-OP *   pp_i_divide     _((void));
-OP *   pp_modulo       _((void));
-OP *   pp_i_modulo     _((void));
-OP *   pp_repeat       _((void));
-OP *   pp_add          _((void));
-OP *   pp_i_add        _((void));
-OP *   pp_subtract     _((void));
-OP *   pp_i_subtract   _((void));
-OP *   pp_concat       _((void));
-OP *   pp_stringify    _((void));
-OP *   pp_left_shift   _((void));
-OP *   pp_right_shift  _((void));
-OP *   pp_lt           _((void));
-OP *   pp_i_lt         _((void));
-OP *   pp_gt           _((void));
-OP *   pp_i_gt         _((void));
-OP *   pp_le           _((void));
-OP *   pp_i_le         _((void));
-OP *   pp_ge           _((void));
-OP *   pp_i_ge         _((void));
-OP *   pp_eq           _((void));
-OP *   pp_i_eq         _((void));
-OP *   pp_ne           _((void));
-OP *   pp_i_ne         _((void));
-OP *   pp_ncmp         _((void));
-OP *   pp_i_ncmp       _((void));
-OP *   pp_slt          _((void));
-OP *   pp_sgt          _((void));
-OP *   pp_sle          _((void));
-OP *   pp_sge          _((void));
-OP *   pp_seq          _((void));
-OP *   pp_sne          _((void));
-OP *   pp_scmp         _((void));
-OP *   pp_bit_and      _((void));
-OP *   pp_bit_xor      _((void));
-OP *   pp_bit_or       _((void));
-OP *   pp_negate       _((void));
-OP *   pp_i_negate     _((void));
-OP *   pp_not          _((void));
-OP *   pp_complement   _((void));
-OP *   pp_atan2        _((void));
-OP *   pp_sin          _((void));
-OP *   pp_cos          _((void));
-OP *   pp_rand         _((void));
-OP *   pp_srand        _((void));
-OP *   pp_exp          _((void));
-OP *   pp_log          _((void));
-OP *   pp_sqrt         _((void));
-OP *   pp_int          _((void));
-OP *   pp_hex          _((void));
-OP *   pp_oct          _((void));
-OP *   pp_abs          _((void));
-OP *   pp_length       _((void));
-OP *   pp_substr       _((void));
-OP *   pp_vec          _((void));
-OP *   pp_index        _((void));
-OP *   pp_rindex       _((void));
-OP *   pp_sprintf      _((void));
-OP *   pp_formline     _((void));
-OP *   pp_ord          _((void));
-OP *   pp_chr          _((void));
-OP *   pp_crypt        _((void));
-OP *   pp_ucfirst      _((void));
-OP *   pp_lcfirst      _((void));
-OP *   pp_uc           _((void));
-OP *   pp_lc           _((void));
-OP *   pp_quotemeta    _((void));
-OP *   pp_rv2av        _((void));
-OP *   pp_aelemfast    _((void));
-OP *   pp_aelem        _((void));
-OP *   pp_aslice       _((void));
-OP *   pp_each         _((void));
-OP *   pp_values       _((void));
-OP *   pp_keys         _((void));
-OP *   pp_delete       _((void));
-OP *   pp_exists       _((void));
-OP *   pp_rv2hv        _((void));
-OP *   pp_helem        _((void));
-OP *   pp_hslice       _((void));
-OP *   pp_unpack       _((void));
-OP *   pp_pack         _((void));
-OP *   pp_split        _((void));
-OP *   pp_join         _((void));
-OP *   pp_list         _((void));
-OP *   pp_lslice       _((void));
-OP *   pp_anonlist     _((void));
-OP *   pp_anonhash     _((void));
-OP *   pp_splice       _((void));
-OP *   pp_push         _((void));
-OP *   pp_pop          _((void));
-OP *   pp_shift        _((void));
-OP *   pp_unshift      _((void));
-OP *   pp_sort         _((void));
-OP *   pp_reverse      _((void));
-OP *   pp_grepstart    _((void));
-OP *   pp_grepwhile    _((void));
-OP *   pp_mapstart     _((void));
-OP *   pp_mapwhile     _((void));
-OP *   pp_range        _((void));
-OP *   pp_flip         _((void));
-OP *   pp_flop         _((void));
-OP *   pp_and          _((void));
-OP *   pp_or           _((void));
-OP *   pp_xor          _((void));
-OP *   pp_cond_expr    _((void));
-OP *   pp_andassign    _((void));
-OP *   pp_orassign     _((void));
-OP *   pp_method       _((void));
-OP *   pp_entersub     _((void));
-OP *   pp_leavesub     _((void));
-OP *   pp_caller       _((void));
-OP *   pp_warn         _((void));
-OP *   pp_die          _((void));
-OP *   pp_reset        _((void));
-OP *   pp_lineseq      _((void));
-OP *   pp_nextstate    _((void));
-OP *   pp_dbstate      _((void));
-OP *   pp_unstack      _((void));
-OP *   pp_enter        _((void));
-OP *   pp_leave        _((void));
-OP *   pp_scope        _((void));
-OP *   pp_enteriter    _((void));
-OP *   pp_iter         _((void));
-OP *   pp_enterloop    _((void));
-OP *   pp_leaveloop    _((void));
-OP *   pp_return       _((void));
-OP *   pp_last         _((void));
-OP *   pp_next         _((void));
-OP *   pp_redo         _((void));
-OP *   pp_dump         _((void));
-OP *   pp_goto         _((void));
-OP *   pp_exit         _((void));
-OP *   pp_open         _((void));
-OP *   pp_close        _((void));
-OP *   pp_pipe_op      _((void));
-OP *   pp_fileno       _((void));
-OP *   pp_umask        _((void));
-OP *   pp_binmode      _((void));
-OP *   pp_tie          _((void));
-OP *   pp_untie        _((void));
-OP *   pp_tied         _((void));
-OP *   pp_dbmopen      _((void));
-OP *   pp_dbmclose     _((void));
-OP *   pp_sselect      _((void));
-OP *   pp_select       _((void));
-OP *   pp_getc         _((void));
-OP *   pp_read         _((void));
-OP *   pp_enterwrite   _((void));
-OP *   pp_leavewrite   _((void));
-OP *   pp_prtf         _((void));
-OP *   pp_print        _((void));
-OP *   pp_sysopen      _((void));
-OP *   pp_sysread      _((void));
-OP *   pp_syswrite     _((void));
-OP *   pp_send         _((void));
-OP *   pp_recv         _((void));
-OP *   pp_eof          _((void));
-OP *   pp_tell         _((void));
-OP *   pp_seek         _((void));
-OP *   pp_truncate     _((void));
-OP *   pp_fcntl        _((void));
-OP *   pp_ioctl        _((void));
-OP *   pp_flock        _((void));
-OP *   pp_socket       _((void));
-OP *   pp_sockpair     _((void));
-OP *   pp_bind         _((void));
-OP *   pp_connect      _((void));
-OP *   pp_listen       _((void));
-OP *   pp_accept       _((void));
-OP *   pp_shutdown     _((void));
-OP *   pp_gsockopt     _((void));
-OP *   pp_ssockopt     _((void));
-OP *   pp_getsockname  _((void));
-OP *   pp_getpeername  _((void));
-OP *   pp_lstat        _((void));
-OP *   pp_stat         _((void));
-OP *   pp_ftrread      _((void));
-OP *   pp_ftrwrite     _((void));
-OP *   pp_ftrexec      _((void));
-OP *   pp_fteread      _((void));
-OP *   pp_ftewrite     _((void));
-OP *   pp_fteexec      _((void));
-OP *   pp_ftis         _((void));
-OP *   pp_fteowned     _((void));
-OP *   pp_ftrowned     _((void));
-OP *   pp_ftzero       _((void));
-OP *   pp_ftsize       _((void));
-OP *   pp_ftmtime      _((void));
-OP *   pp_ftatime      _((void));
-OP *   pp_ftctime      _((void));
-OP *   pp_ftsock       _((void));
-OP *   pp_ftchr        _((void));
-OP *   pp_ftblk        _((void));
-OP *   pp_ftfile       _((void));
-OP *   pp_ftdir        _((void));
-OP *   pp_ftpipe       _((void));
-OP *   pp_ftlink       _((void));
-OP *   pp_ftsuid       _((void));
-OP *   pp_ftsgid       _((void));
-OP *   pp_ftsvtx       _((void));
-OP *   pp_fttty        _((void));
-OP *   pp_fttext       _((void));
-OP *   pp_ftbinary     _((void));
-OP *   pp_chdir        _((void));
-OP *   pp_chown        _((void));
-OP *   pp_chroot       _((void));
-OP *   pp_unlink       _((void));
-OP *   pp_chmod        _((void));
-OP *   pp_utime        _((void));
-OP *   pp_rename       _((void));
-OP *   pp_link         _((void));
-OP *   pp_symlink      _((void));
-OP *   pp_readlink     _((void));
-OP *   pp_mkdir        _((void));
-OP *   pp_rmdir        _((void));
-OP *   pp_open_dir     _((void));
-OP *   pp_readdir      _((void));
-OP *   pp_telldir      _((void));
-OP *   pp_seekdir      _((void));
-OP *   pp_rewinddir    _((void));
-OP *   pp_closedir     _((void));
-OP *   pp_fork         _((void));
-OP *   pp_wait         _((void));
-OP *   pp_waitpid      _((void));
-OP *   pp_system       _((void));
-OP *   pp_exec         _((void));
-OP *   pp_kill         _((void));
-OP *   pp_getppid      _((void));
-OP *   pp_getpgrp      _((void));
-OP *   pp_setpgrp      _((void));
-OP *   pp_getpriority  _((void));
-OP *   pp_setpriority  _((void));
-OP *   pp_time         _((void));
-OP *   pp_tms          _((void));
-OP *   pp_localtime    _((void));
-OP *   pp_gmtime       _((void));
-OP *   pp_alarm        _((void));
-OP *   pp_sleep        _((void));
-OP *   pp_shmget       _((void));
-OP *   pp_shmctl       _((void));
-OP *   pp_shmread      _((void));
-OP *   pp_shmwrite     _((void));
-OP *   pp_msgget       _((void));
-OP *   pp_msgctl       _((void));
-OP *   pp_msgsnd       _((void));
-OP *   pp_msgrcv       _((void));
-OP *   pp_semget       _((void));
-OP *   pp_semctl       _((void));
-OP *   pp_semop        _((void));
-OP *   pp_require      _((void));
-OP *   pp_dofile       _((void));
-OP *   pp_entereval    _((void));
-OP *   pp_leaveeval    _((void));
-OP *   pp_entertry     _((void));
-OP *   pp_leavetry     _((void));
-OP *   pp_ghbyname     _((void));
-OP *   pp_ghbyaddr     _((void));
-OP *   pp_ghostent     _((void));
-OP *   pp_gnbyname     _((void));
-OP *   pp_gnbyaddr     _((void));
-OP *   pp_gnetent      _((void));
-OP *   pp_gpbyname     _((void));
-OP *   pp_gpbynumber   _((void));
-OP *   pp_gprotoent    _((void));
-OP *   pp_gsbyname     _((void));
-OP *   pp_gsbyport     _((void));
-OP *   pp_gservent     _((void));
-OP *   pp_shostent     _((void));
-OP *   pp_snetent      _((void));
-OP *   pp_sprotoent    _((void));
-OP *   pp_sservent     _((void));
-OP *   pp_ehostent     _((void));
-OP *   pp_enetent      _((void));
-OP *   pp_eprotoent    _((void));
-OP *   pp_eservent     _((void));
-OP *   pp_gpwnam       _((void));
-OP *   pp_gpwuid       _((void));
-OP *   pp_gpwent       _((void));
-OP *   pp_spwent       _((void));
-OP *   pp_epwent       _((void));
-OP *   pp_ggrnam       _((void));
-OP *   pp_ggrgid       _((void));
-OP *   pp_ggrent       _((void));
-OP *   pp_sgrent       _((void));
-OP *   pp_egrent       _((void));
-OP *   pp_getlogin     _((void));
-OP *   pp_syscall      _((void));
+OP *   pp_null         _((ARGSproto));
+OP *   pp_stub         _((ARGSproto));
+OP *   pp_scalar       _((ARGSproto));
+OP *   pp_pushmark     _((ARGSproto));
+OP *   pp_wantarray    _((ARGSproto));
+OP *   pp_const        _((ARGSproto));
+OP *   pp_gvsv         _((ARGSproto));
+OP *   pp_gv           _((ARGSproto));
+OP *   pp_gelem        _((ARGSproto));
+OP *   pp_padsv        _((ARGSproto));
+OP *   pp_padav        _((ARGSproto));
+OP *   pp_padhv        _((ARGSproto));
+OP *   pp_padany       _((ARGSproto));
+OP *   pp_pushre       _((ARGSproto));
+OP *   pp_rv2gv        _((ARGSproto));
+OP *   pp_rv2sv        _((ARGSproto));
+OP *   pp_av2arylen    _((ARGSproto));
+OP *   pp_rv2cv        _((ARGSproto));
+OP *   pp_anoncode     _((ARGSproto));
+OP *   pp_prototype    _((ARGSproto));
+OP *   pp_refgen       _((ARGSproto));
+OP *   pp_srefgen      _((ARGSproto));
+OP *   pp_ref          _((ARGSproto));
+OP *   pp_bless        _((ARGSproto));
+OP *   pp_backtick     _((ARGSproto));
+OP *   pp_glob         _((ARGSproto));
+OP *   pp_readline     _((ARGSproto));
+OP *   pp_rcatline     _((ARGSproto));
+OP *   pp_regcmaybe    _((ARGSproto));
+OP *   pp_regcomp      _((ARGSproto));
+OP *   pp_match        _((ARGSproto));
+OP *   pp_subst        _((ARGSproto));
+OP *   pp_substcont    _((ARGSproto));
+OP *   pp_trans        _((ARGSproto));
+OP *   pp_sassign      _((ARGSproto));
+OP *   pp_aassign      _((ARGSproto));
+OP *   pp_chop         _((ARGSproto));
+OP *   pp_schop        _((ARGSproto));
+OP *   pp_chomp        _((ARGSproto));
+OP *   pp_schomp       _((ARGSproto));
+OP *   pp_defined      _((ARGSproto));
+OP *   pp_undef        _((ARGSproto));
+OP *   pp_study        _((ARGSproto));
+OP *   pp_pos          _((ARGSproto));
+OP *   pp_preinc       _((ARGSproto));
+OP *   pp_i_preinc     _((ARGSproto));
+OP *   pp_predec       _((ARGSproto));
+OP *   pp_i_predec     _((ARGSproto));
+OP *   pp_postinc      _((ARGSproto));
+OP *   pp_i_postinc    _((ARGSproto));
+OP *   pp_postdec      _((ARGSproto));
+OP *   pp_i_postdec    _((ARGSproto));
+OP *   pp_pow          _((ARGSproto));
+OP *   pp_multiply     _((ARGSproto));
+OP *   pp_i_multiply   _((ARGSproto));
+OP *   pp_divide       _((ARGSproto));
+OP *   pp_i_divide     _((ARGSproto));
+OP *   pp_modulo       _((ARGSproto));
+OP *   pp_i_modulo     _((ARGSproto));
+OP *   pp_repeat       _((ARGSproto));
+OP *   pp_add          _((ARGSproto));
+OP *   pp_i_add        _((ARGSproto));
+OP *   pp_subtract     _((ARGSproto));
+OP *   pp_i_subtract   _((ARGSproto));
+OP *   pp_concat       _((ARGSproto));
+OP *   pp_stringify    _((ARGSproto));
+OP *   pp_left_shift   _((ARGSproto));
+OP *   pp_right_shift  _((ARGSproto));
+OP *   pp_lt           _((ARGSproto));
+OP *   pp_i_lt         _((ARGSproto));
+OP *   pp_gt           _((ARGSproto));
+OP *   pp_i_gt         _((ARGSproto));
+OP *   pp_le           _((ARGSproto));
+OP *   pp_i_le         _((ARGSproto));
+OP *   pp_ge           _((ARGSproto));
+OP *   pp_i_ge         _((ARGSproto));
+OP *   pp_eq           _((ARGSproto));
+OP *   pp_i_eq         _((ARGSproto));
+OP *   pp_ne           _((ARGSproto));
+OP *   pp_i_ne         _((ARGSproto));
+OP *   pp_ncmp         _((ARGSproto));
+OP *   pp_i_ncmp       _((ARGSproto));
+OP *   pp_slt          _((ARGSproto));
+OP *   pp_sgt          _((ARGSproto));
+OP *   pp_sle          _((ARGSproto));
+OP *   pp_sge          _((ARGSproto));
+OP *   pp_seq          _((ARGSproto));
+OP *   pp_sne          _((ARGSproto));
+OP *   pp_scmp         _((ARGSproto));
+OP *   pp_bit_and      _((ARGSproto));
+OP *   pp_bit_xor      _((ARGSproto));
+OP *   pp_bit_or       _((ARGSproto));
+OP *   pp_negate       _((ARGSproto));
+OP *   pp_i_negate     _((ARGSproto));
+OP *   pp_not          _((ARGSproto));
+OP *   pp_complement   _((ARGSproto));
+OP *   pp_atan2        _((ARGSproto));
+OP *   pp_sin          _((ARGSproto));
+OP *   pp_cos          _((ARGSproto));
+OP *   pp_rand         _((ARGSproto));
+OP *   pp_srand        _((ARGSproto));
+OP *   pp_exp          _((ARGSproto));
+OP *   pp_log          _((ARGSproto));
+OP *   pp_sqrt         _((ARGSproto));
+OP *   pp_int          _((ARGSproto));
+OP *   pp_hex          _((ARGSproto));
+OP *   pp_oct          _((ARGSproto));
+OP *   pp_abs          _((ARGSproto));
+OP *   pp_length       _((ARGSproto));
+OP *   pp_substr       _((ARGSproto));
+OP *   pp_vec          _((ARGSproto));
+OP *   pp_index        _((ARGSproto));
+OP *   pp_rindex       _((ARGSproto));
+OP *   pp_sprintf      _((ARGSproto));
+OP *   pp_formline     _((ARGSproto));
+OP *   pp_ord          _((ARGSproto));
+OP *   pp_chr          _((ARGSproto));
+OP *   pp_crypt        _((ARGSproto));
+OP *   pp_ucfirst      _((ARGSproto));
+OP *   pp_lcfirst      _((ARGSproto));
+OP *   pp_uc           _((ARGSproto));
+OP *   pp_lc           _((ARGSproto));
+OP *   pp_quotemeta    _((ARGSproto));
+OP *   pp_rv2av        _((ARGSproto));
+OP *   pp_aelemfast    _((ARGSproto));
+OP *   pp_aelem        _((ARGSproto));
+OP *   pp_aslice       _((ARGSproto));
+OP *   pp_each         _((ARGSproto));
+OP *   pp_values       _((ARGSproto));
+OP *   pp_keys         _((ARGSproto));
+OP *   pp_delete       _((ARGSproto));
+OP *   pp_exists       _((ARGSproto));
+OP *   pp_rv2hv        _((ARGSproto));
+OP *   pp_helem        _((ARGSproto));
+OP *   pp_hslice       _((ARGSproto));
+OP *   pp_unpack       _((ARGSproto));
+OP *   pp_pack         _((ARGSproto));
+OP *   pp_split        _((ARGSproto));
+OP *   pp_join         _((ARGSproto));
+OP *   pp_list         _((ARGSproto));
+OP *   pp_lslice       _((ARGSproto));
+OP *   pp_anonlist     _((ARGSproto));
+OP *   pp_anonhash     _((ARGSproto));
+OP *   pp_splice       _((ARGSproto));
+OP *   pp_push         _((ARGSproto));
+OP *   pp_pop          _((ARGSproto));
+OP *   pp_shift        _((ARGSproto));
+OP *   pp_unshift      _((ARGSproto));
+OP *   pp_sort         _((ARGSproto));
+OP *   pp_reverse      _((ARGSproto));
+OP *   pp_grepstart    _((ARGSproto));
+OP *   pp_grepwhile    _((ARGSproto));
+OP *   pp_mapstart     _((ARGSproto));
+OP *   pp_mapwhile     _((ARGSproto));
+OP *   pp_range        _((ARGSproto));
+OP *   pp_flip         _((ARGSproto));
+OP *   pp_flop         _((ARGSproto));
+OP *   pp_and          _((ARGSproto));
+OP *   pp_or           _((ARGSproto));
+OP *   pp_xor          _((ARGSproto));
+OP *   pp_cond_expr    _((ARGSproto));
+OP *   pp_andassign    _((ARGSproto));
+OP *   pp_orassign     _((ARGSproto));
+OP *   pp_method       _((ARGSproto));
+OP *   pp_entersub     _((ARGSproto));
+OP *   pp_leavesub     _((ARGSproto));
+OP *   pp_caller       _((ARGSproto));
+OP *   pp_warn         _((ARGSproto));
+OP *   pp_die          _((ARGSproto));
+OP *   pp_reset        _((ARGSproto));
+OP *   pp_lineseq      _((ARGSproto));
+OP *   pp_nextstate    _((ARGSproto));
+OP *   pp_dbstate      _((ARGSproto));
+OP *   pp_unstack      _((ARGSproto));
+OP *   pp_enter        _((ARGSproto));
+OP *   pp_leave        _((ARGSproto));
+OP *   pp_scope        _((ARGSproto));
+OP *   pp_enteriter    _((ARGSproto));
+OP *   pp_iter         _((ARGSproto));
+OP *   pp_enterloop    _((ARGSproto));
+OP *   pp_leaveloop    _((ARGSproto));
+OP *   pp_return       _((ARGSproto));
+OP *   pp_last         _((ARGSproto));
+OP *   pp_next         _((ARGSproto));
+OP *   pp_redo         _((ARGSproto));
+OP *   pp_dump         _((ARGSproto));
+OP *   pp_goto         _((ARGSproto));
+OP *   pp_exit         _((ARGSproto));
+OP *   pp_open         _((ARGSproto));
+OP *   pp_close        _((ARGSproto));
+OP *   pp_pipe_op      _((ARGSproto));
+OP *   pp_fileno       _((ARGSproto));
+OP *   pp_umask        _((ARGSproto));
+OP *   pp_binmode      _((ARGSproto));
+OP *   pp_tie          _((ARGSproto));
+OP *   pp_untie        _((ARGSproto));
+OP *   pp_tied         _((ARGSproto));
+OP *   pp_dbmopen      _((ARGSproto));
+OP *   pp_dbmclose     _((ARGSproto));
+OP *   pp_sselect      _((ARGSproto));
+OP *   pp_select       _((ARGSproto));
+OP *   pp_getc         _((ARGSproto));
+OP *   pp_read         _((ARGSproto));
+OP *   pp_enterwrite   _((ARGSproto));
+OP *   pp_leavewrite   _((ARGSproto));
+OP *   pp_prtf         _((ARGSproto));
+OP *   pp_print        _((ARGSproto));
+OP *   pp_sysopen      _((ARGSproto));
+OP *   pp_sysread      _((ARGSproto));
+OP *   pp_syswrite     _((ARGSproto));
+OP *   pp_send         _((ARGSproto));
+OP *   pp_recv         _((ARGSproto));
+OP *   pp_eof          _((ARGSproto));
+OP *   pp_tell         _((ARGSproto));
+OP *   pp_seek         _((ARGSproto));
+OP *   pp_truncate     _((ARGSproto));
+OP *   pp_fcntl        _((ARGSproto));
+OP *   pp_ioctl        _((ARGSproto));
+OP *   pp_flock        _((ARGSproto));
+OP *   pp_socket       _((ARGSproto));
+OP *   pp_sockpair     _((ARGSproto));
+OP *   pp_bind         _((ARGSproto));
+OP *   pp_connect      _((ARGSproto));
+OP *   pp_listen       _((ARGSproto));
+OP *   pp_accept       _((ARGSproto));
+OP *   pp_shutdown     _((ARGSproto));
+OP *   pp_gsockopt     _((ARGSproto));
+OP *   pp_ssockopt     _((ARGSproto));
+OP *   pp_getsockname  _((ARGSproto));
+OP *   pp_getpeername  _((ARGSproto));
+OP *   pp_lstat        _((ARGSproto));
+OP *   pp_stat         _((ARGSproto));
+OP *   pp_ftrread      _((ARGSproto));
+OP *   pp_ftrwrite     _((ARGSproto));
+OP *   pp_ftrexec      _((ARGSproto));
+OP *   pp_fteread      _((ARGSproto));
+OP *   pp_ftewrite     _((ARGSproto));
+OP *   pp_fteexec      _((ARGSproto));
+OP *   pp_ftis         _((ARGSproto));
+OP *   pp_fteowned     _((ARGSproto));
+OP *   pp_ftrowned     _((ARGSproto));
+OP *   pp_ftzero       _((ARGSproto));
+OP *   pp_ftsize       _((ARGSproto));
+OP *   pp_ftmtime      _((ARGSproto));
+OP *   pp_ftatime      _((ARGSproto));
+OP *   pp_ftctime      _((ARGSproto));
+OP *   pp_ftsock       _((ARGSproto));
+OP *   pp_ftchr        _((ARGSproto));
+OP *   pp_ftblk        _((ARGSproto));
+OP *   pp_ftfile       _((ARGSproto));
+OP *   pp_ftdir        _((ARGSproto));
+OP *   pp_ftpipe       _((ARGSproto));
+OP *   pp_ftlink       _((ARGSproto));
+OP *   pp_ftsuid       _((ARGSproto));
+OP *   pp_ftsgid       _((ARGSproto));
+OP *   pp_ftsvtx       _((ARGSproto));
+OP *   pp_fttty        _((ARGSproto));
+OP *   pp_fttext       _((ARGSproto));
+OP *   pp_ftbinary     _((ARGSproto));
+OP *   pp_chdir        _((ARGSproto));
+OP *   pp_chown        _((ARGSproto));
+OP *   pp_chroot       _((ARGSproto));
+OP *   pp_unlink       _((ARGSproto));
+OP *   pp_chmod        _((ARGSproto));
+OP *   pp_utime        _((ARGSproto));
+OP *   pp_rename       _((ARGSproto));
+OP *   pp_link         _((ARGSproto));
+OP *   pp_symlink      _((ARGSproto));
+OP *   pp_readlink     _((ARGSproto));
+OP *   pp_mkdir        _((ARGSproto));
+OP *   pp_rmdir        _((ARGSproto));
+OP *   pp_open_dir     _((ARGSproto));
+OP *   pp_readdir      _((ARGSproto));
+OP *   pp_telldir      _((ARGSproto));
+OP *   pp_seekdir      _((ARGSproto));
+OP *   pp_rewinddir    _((ARGSproto));
+OP *   pp_closedir     _((ARGSproto));
+OP *   pp_fork         _((ARGSproto));
+OP *   pp_wait         _((ARGSproto));
+OP *   pp_waitpid      _((ARGSproto));
+OP *   pp_system       _((ARGSproto));
+OP *   pp_exec         _((ARGSproto));
+OP *   pp_kill         _((ARGSproto));
+OP *   pp_getppid      _((ARGSproto));
+OP *   pp_getpgrp      _((ARGSproto));
+OP *   pp_setpgrp      _((ARGSproto));
+OP *   pp_getpriority  _((ARGSproto));
+OP *   pp_setpriority  _((ARGSproto));
+OP *   pp_time         _((ARGSproto));
+OP *   pp_tms          _((ARGSproto));
+OP *   pp_localtime    _((ARGSproto));
+OP *   pp_gmtime       _((ARGSproto));
+OP *   pp_alarm        _((ARGSproto));
+OP *   pp_sleep        _((ARGSproto));
+OP *   pp_shmget       _((ARGSproto));
+OP *   pp_shmctl       _((ARGSproto));
+OP *   pp_shmread      _((ARGSproto));
+OP *   pp_shmwrite     _((ARGSproto));
+OP *   pp_msgget       _((ARGSproto));
+OP *   pp_msgctl       _((ARGSproto));
+OP *   pp_msgsnd       _((ARGSproto));
+OP *   pp_msgrcv       _((ARGSproto));
+OP *   pp_semget       _((ARGSproto));
+OP *   pp_semctl       _((ARGSproto));
+OP *   pp_semop        _((ARGSproto));
+OP *   pp_require      _((ARGSproto));
+OP *   pp_dofile       _((ARGSproto));
+OP *   pp_entereval    _((ARGSproto));
+OP *   pp_leaveeval    _((ARGSproto));
+OP *   pp_entertry     _((ARGSproto));
+OP *   pp_leavetry     _((ARGSproto));
+OP *   pp_ghbyname     _((ARGSproto));
+OP *   pp_ghbyaddr     _((ARGSproto));
+OP *   pp_ghostent     _((ARGSproto));
+OP *   pp_gnbyname     _((ARGSproto));
+OP *   pp_gnbyaddr     _((ARGSproto));
+OP *   pp_gnetent      _((ARGSproto));
+OP *   pp_gpbyname     _((ARGSproto));
+OP *   pp_gpbynumber   _((ARGSproto));
+OP *   pp_gprotoent    _((ARGSproto));
+OP *   pp_gsbyname     _((ARGSproto));
+OP *   pp_gsbyport     _((ARGSproto));
+OP *   pp_gservent     _((ARGSproto));
+OP *   pp_shostent     _((ARGSproto));
+OP *   pp_snetent      _((ARGSproto));
+OP *   pp_sprotoent    _((ARGSproto));
+OP *   pp_sservent     _((ARGSproto));
+OP *   pp_ehostent     _((ARGSproto));
+OP *   pp_enetent      _((ARGSproto));
+OP *   pp_eprotoent    _((ARGSproto));
+OP *   pp_eservent     _((ARGSproto));
+OP *   pp_gpwnam       _((ARGSproto));
+OP *   pp_gpwuid       _((ARGSproto));
+OP *   pp_gpwent       _((ARGSproto));
+OP *   pp_spwent       _((ARGSproto));
+OP *   pp_epwent       _((ARGSproto));
+OP *   pp_ggrnam       _((ARGSproto));
+OP *   pp_ggrgid       _((ARGSproto));
+OP *   pp_ggrent       _((ARGSproto));
+OP *   pp_sgrent       _((ARGSproto));
+OP *   pp_egrent       _((ARGSproto));
+OP *   pp_getlogin     _((ARGSproto));
+OP *   pp_syscall      _((ARGSproto));
 
 #ifndef DOINIT
 EXT OP * (*ppaddr[])();
index fddf646..19b94a9 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -81,13 +81,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 6c7723a..f3c14c9 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -44,8 +44,10 @@ 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 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*));
 
@@ -65,6 +67,10 @@ void
 perl_construct( sv_interp )
 register PerlInterpreter *sv_interp;
 {
+#ifdef USE_THREADS
+    struct thread *thr;
+#endif /* USE_THREADS */
+    
     if (!(curinterp = sv_interp))
        return;
 
@@ -72,6 +78,20 @@ 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();
+#endif /* USE_THREADS */
+
     /* Init the real globals? */
     if (!linestr) {
        linestr = NEWSV(65,80);
@@ -90,6 +110,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);
+
 #ifdef MSDOS
        /*
         * There is no way we can refer to them from Perl so close them to save
@@ -132,14 +158,42 @@ register PerlInterpreter *sv_interp;
     fdpid = newAV();   /* for remembering popen pids by fd */
     pidstatus = newHV();/* for remembering status of dead pids */
 
-    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;
@@ -147,6 +201,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
     {
@@ -214,6 +284,11 @@ register PerlInterpreter *sv_interp;
     sv_free_arenas();
     
     DEBUG_P(debprofdump());
+#ifdef USE_THREADS
+    MUTEX_DESTROY(&sv_mutex);
+    MUTEX_DESTROY(&malloc_mutex);
+    MUTEX_DESTROY(&eval_mutex);
+#endif /* USE_THREADS */
 }
 
 void
@@ -236,6 +311,7 @@ int argc;
 char **argv;
 char **env;
 {
+    dTHR;
     register SV *sv;
     register char *s;
     char *scriptname = NULL;
@@ -436,6 +512,13 @@ setuid perl scripts securely.\n");
 
     compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)compcv, SVt_PVCV);
+#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 */
 
     pad = newAV();
     comppad = pad;
@@ -444,6 +527,9 @@ setuid perl scripts securely.\n");
     padname = newAV();
     comppad_name = padname;
     comppad_name_fill = 0;
+#ifdef USE_THREADS
+    av_store(comppad_name, 0, newSVpv("@_", 2));
+#endif /* USE_THREADS */
     min_intro_pending = 0;
     padix = 0;
 
@@ -513,6 +599,7 @@ int
 perl_run(sv_interp)
 PerlInterpreter *sv_interp;
 {
+    dTHR;
     if (!(curinterp = sv_interp))
        return 255;
     switch (Sigsetjmp(top_env,1)) {
@@ -545,6 +632,9 @@ PerlInterpreter *sv_interp;
     if (!restartop) {
        DEBUG_x(dump_all());
        DEBUG(fprintf(stderr,"\nEXECUTING...\n\n"));
+#ifdef USE_THREADS
+       DEBUG_L(fprintf(stderr,"main thread is 0x%lx\n", (unsigned long) thr));
+#endif /* USE_THREADS */       
 
        if (minus_c) {
            fprintf(stderr,"%s syntax OK\n", origfilename);
@@ -574,10 +664,15 @@ void
 my_exit(status)
 U32 status;
 {
+    dTHR;
     register CONTEXT *cx;
     I32 gimme;
     SV **newsp;
 
+#ifdef USE_THREADS
+    DEBUG_L(fprintf(stderr, "my_exit: thread 0x%lx, status %lu\n",
+                   (unsigned long) thr, (unsigned long) status));
+#endif /* USE_THREADS */
     statusvalue = FIXSTATUS(status);
     if (cxstack_ix >= 0) {
        if (cxstack_ix > 0)
@@ -649,6 +744,7 @@ char *subname;
 I32 flags;             /* See G_* flags in cop.h */
 register char **argv;  /* null terminated arg list */
 {
+    dTHR;
     dSP;
 
     PUSHMARK(sp);
@@ -675,13 +771,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);
 }
 
@@ -691,6 +788,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 = TOPMARK;
@@ -781,7 +879,7 @@ I32 flags;          /* See G_* flags in cop.h */
     }
 
     if (op == (OP*)&myop)
-       op = pp_entersub();
+       op = pp_entersub(ARGS);
     if (op)
        runops();
     retval = stack_sp - (stack_base + oldmark);
@@ -821,6 +919,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;
@@ -886,7 +985,7 @@ restart:
     }
 
     if (op == (OP*)&myop)
-       op = pp_entereval();
+       op = pp_entereval(ARGS);
     if (op)
        runops();
     retval = stack_sp - (stack_base + oldmark);
@@ -1120,30 +1219,31 @@ char *s;
        taint_not("-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));
@@ -1286,6 +1386,7 @@ my_unexec()
 static void
 init_main_stash()
 {
+    dTHR;
     GV *gv;
     curstash = defstash = newHV();
     curstname = newSVpv("main",4);
@@ -1798,6 +1899,7 @@ init_ids()
 static void
 init_debugger()
 {
+    dTHR;
     curstash = debstash;
     dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
     AvREAL_off(dbargs);
@@ -1813,8 +1915,9 @@ init_debugger()
     curstash = defstash;
 }
 
-static void
-init_stacks()
+void
+init_stacks(ARGS)
+dARGS
 {
     stack = newAV();
     mainstack = stack;                 /* remember in case we switch stacks */
@@ -1848,11 +1951,6 @@ init_stacks()
     New(50,tmps_stack,128,SV*);
     tmps_ix = -1;
     tmps_max = 128;
-
-    DEBUG( {
-       New(51,debname,128,char);
-       New(52,debdelim,128,char);
-    } )
 }
 
 static FILE *tmpfp;  /* moved outside init_lexer() because of UNICOS bug */
@@ -1869,6 +1967,7 @@ init_lexer()
 static void
 init_predump_symbols()
 {
+    dTHR;
     GV *tmpgv;
     GV *othergv;
 
@@ -2033,6 +2132,7 @@ void
 calllist(list)
 AV* list;
 {
+    dTHR;
     Sigjmp_buf oldtop;
     STRLEN len;
     line_t oldline = curcop->cop_line;
diff --git a/perl.h b/perl.h
index bfb9210..97971f9 100644 (file)
--- a/perl.h
+++ b/perl.h
 # endif
 #endif
 
+#ifdef USE_THREADS
+#include <pthread.h>
+#endif
+
 #include "embed.h"
 
 #define VOIDUSED 1
@@ -607,6 +611,12 @@ union any {
     void       (*any_dptr) _((void*));
 };
 
+#ifdef USE_THREADS
+#define ARGSproto struct thread *
+#else
+#define ARGSproto void
+#endif /* USE_THREADS */
+
 #include "regexp.h"
 #include "sv.h"
 #include "util.h"
@@ -867,6 +877,18 @@ I32 unlnk _((char*));
 
 /* 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 */
+
 #ifndef VMS  /* VMS doesn't use environ array */
 extern char ** environ;        /* environment variables supplied via exec */
 #endif
@@ -1412,6 +1434,7 @@ struct interpreter {
 };
 #endif
 
+#include "thread.h"
 #include "pp.h"
 
 #ifdef __cplusplus
diff --git a/pp.h b/pp.h
index 44a3ebe..7fe8f76 100644 (file)
--- 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
index e57e88a..806e4d2 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -24,7 +24,7 @@
 #endif
 
 static OP *doeval _((int gimme));
-static OP *dofindlabel _((OP *op, char *label, OP **opstack));
+static OP *dofindlabel _((OP *o, char *label, OP **opstack));
 static void doparseform _((SV *sv));
 static I32 dopoptoeval _((I32 startingblock));
 static I32 dopoptolabel _((char *label));
@@ -455,8 +455,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;
@@ -471,7 +471,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;
 }
 
@@ -756,6 +756,7 @@ static I32
 dopoptolabel(label)
 char *label;
 {
+    dTHR;
     register I32 i;
     register CONTEXT *cx;
 
@@ -791,6 +792,7 @@ char *label;
 I32
 dowantarray()
 {
+    dTHR;
     I32 cxix;
 
     cxix = dopoptosub(cxstack_ix);
@@ -807,6 +809,7 @@ static I32
 dopoptosub(startingblock)
 I32 startingblock;
 {
+    dTHR;
     I32 i;
     register CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
@@ -827,6 +830,7 @@ static I32
 dopoptoeval(startingblock)
 I32 startingblock;
 {
+    dTHR;
     I32 i;
     register CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
@@ -846,6 +850,7 @@ static I32
 dopoptoloop(startingblock)
 I32 startingblock;
 {
+    dTHR;
     I32 i;
     register CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
@@ -875,6 +880,7 @@ void
 dounwind(cxix)
 I32 cxix;
 {
+    dTHR;
     register CONTEXT *cx;
     SV **newsp;
     I32 optype;
@@ -911,6 +917,7 @@ die(pat, va_alist)
     va_dcl
 #endif
 {
+    dTHR;
     va_list args;
     char *message;
     int oldrunlevel = runlevel;
@@ -945,6 +952,7 @@ OP *
 die_where(message)
 char *message;
 {
+    dTHR;
     if (in_eval) {
        I32 cxix;
        register CONTEXT *cx;
@@ -1054,7 +1062,7 @@ PP(pp_entersubr)
        mark++;
     }
     *sp = cv;
-    return pp_entersub();
+    return pp_entersub(ARGS);
 }
 #endif
 
@@ -1155,6 +1163,7 @@ sortcv(a, b)
 const void *a;
 const void *b;
 {
+    dTHR;
     SV **str1 = (SV **) a;
     SV **str2 = (SV **) b;
     I32 oldsaveix = savestack_ix;
@@ -1544,28 +1553,28 @@ PP(pp_redo)
 static OP* lastgotoprobe;
 
 static OP *
-dofindlabel(op,label,opstack)
-OP *op;
+dofindlabel(o,label,opstack)
+OP *o;
 char *label;
 OP **opstack;
 {
     OP *kid;
     OP **ops = opstack;
 
-    if (op->op_type == OP_LEAVE ||
-       op->op_type == OP_SCOPE ||
-       op->op_type == OP_LEAVELOOP ||
-       op->op_type == OP_LEAVETRY)
-           *ops++ = cUNOP->op_first;
+    if (o->op_type == OP_LEAVE ||
+       o->op_type == OP_SCOPE ||
+       o->op_type == OP_LEAVELOOP ||
+       o->op_type == OP_LEAVETRY)
+           *ops++ = cUNOPo->op_first;
     *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) {
@@ -1576,8 +1585,8 @@ OP **opstack;
                else
                    *ops++ = kid;
            }
-           if (op = dofindlabel(kid,label,ops))
-               return op;
+           if (o = dofindlabel(kid,label,ops))
+               return o;
        }
     }
     *ops = 0;
@@ -1824,7 +1833,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;
        }
@@ -1937,11 +1946,18 @@ static OP *
 doeval(gimme)
 int gimme;
 {
+    dTHR;
     dSP;
     OP *saveop = op;
     HV *newstash;
     AV* comppadlist;
 
+    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);
     in_eval = 1;
 
     /* set up a scratch pad */
@@ -1957,10 +1973,20 @@ int gimme;
     SAVESPTR(compcv);
     compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)compcv, SVt_PVCV);
+#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);
@@ -2028,6 +2054,10 @@ int gimme;
 
     /* compiled okay, so do it */
 
+    MUTEX_LOCK(&eval_mutex);
+    eval_owner = 0;
+    COND_SIGNAL(&eval_cond);
+    MUTEX_UNLOCK(&eval_mutex);
     RETURNOP(eval_start);
 }
 
index 8fe39f3..b143ff7 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
 
 /* 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;
@@ -932,6 +969,7 @@ ret_no:
 OP *
 do_readline()
 {
+    dTHR;
     dSP; dTARGETSTACKED;
     register SV *sv;
     STRLEN tmplen = 0;
@@ -1733,6 +1771,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) & SVpcv_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));
@@ -1886,8 +2037,8 @@ PP(pp_aelem)
 }
 
 void
-provide_ref(op, sv)
-OP* op;
+provide_ref(o, sv)
+OP* o;
 SV* sv;
 {
     if (SvGMAGICAL(sv))
@@ -1896,7 +2047,7 @@ SV* sv;
        if (SvREADONLY(sv))
            croak(no_modify);
        (void)SvUPGRADE(sv, SVt_RV);
-       SvRV(sv) = (op->op_private & OPpDEREF_HV ?
+       SvRV(sv) = (o->op_private & OPpDEREF_HV ?
                    (SV*)newHV() : (SV*)newAV());
        SvROK_on(sv);
        SvSETMAGIC(sv);
index ba1f105..60a5678 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -419,7 +419,7 @@ PP(pp_tie)
     XPUSHs(gv);
     PUTBACK;
 
-    if (op = pp_entersub())
+    if (op = pp_entersub(ARGS))
         runops();
     SPAGAIN;
 
@@ -504,7 +504,7 @@ PP(pp_dbmopen)
     SAVESPTR(op);
     op = (OP *) &myop;
     PUTBACK;
-    pp_pushmark();
+    pp_pushmark(ARGS);
 
     EXTEND(sp, 5);
     PUSHs(sv);
@@ -517,7 +517,7 @@ PP(pp_dbmopen)
     PUSHs(gv);
     PUTBACK;
 
-    if (op = pp_entersub())
+    if (op = pp_entersub(ARGS))
         runops();
     SPAGAIN;
 
@@ -525,7 +525,7 @@ PP(pp_dbmopen)
        sp--;
        op = (OP *) &myop;
        PUTBACK;
-       pp_pushmark();
+       pp_pushmark(ARGS);
 
        PUSHs(sv);
        PUSHs(left);
@@ -534,7 +534,7 @@ PP(pp_dbmopen)
        PUSHs(gv);
        PUTBACK;
 
-       if (op = pp_entersub())
+       if (op = pp_entersub(ARGS))
            runops();
        SPAGAIN;
     }
@@ -688,6 +688,7 @@ void
 setdefout(gv)
 GV *gv;
 {
+    dTHR;
     if (gv)
        (void)SvREFCNT_inc(gv);
     if (defoutgv)
@@ -758,6 +759,7 @@ CV *cv;
 GV *gv;
 OP *retop;
 {
+    dTHR;
     register CONTEXT *cx;
     I32 gimme = GIMME;
     AV* padlist = CvPADLIST(cv);
diff --git a/proto.h b/proto.h
index 542d566..4a86a34 100644 (file)
--- 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));
 void   av_clear _((AV* ar));
 void   av_extend _((AV* ar, I32 key));
 AV*    av_fake _((I32 size, SV** svp));
@@ -39,8 +39,8 @@ U32   cast_ulong _((double f));
 I32    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));
+OP*    convert _((I32 optype, I32 flags, OP* o));
 char*  cpytill _((char* to, char* from, char* fromend, int delim, I32* retlen));
 void   croak _((char* pat,...)) __attribute__((format(printf,1,2),noreturn));
 CV*    cv_clone _((CV* proto));
@@ -54,7 +54,7 @@ I32   filter_read _((int idx, SV *buffer, int maxlen));
 I32    cxinc _((void));
 void   deb _((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));
@@ -75,7 +75,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));
@@ -116,7 +116,7 @@ char*       fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv));
 OP*    force_list _((OP* arg));
 OP*    fold_constants _((OP * arg));
 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));
@@ -149,6 +149,7 @@ SV**        hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash));
 void   hv_undef _((HV* tb));
 I32    ibcmp _((U8* a, U8* b, I32 len));
 I32    ingroup _((I32 testgid, I32 effective));
+void   init_stacks _((ARGSproto));
 char*  instr _((char* big, char* little));
 bool   io_close _((IO* io));
 OP*    invert _((OP* cmd));
@@ -157,7 +158,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));
@@ -213,45 +214,48 @@ 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));
+#ifdef USE_THREADS
+void   mutex_unlock _((void *m));
+#endif /* USE_THREADS */
 OP *   my _(( OP *));
 char*  my_bcopy _((char* from, char* to, I32 len));
 #if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
 char*  my_bzero _((char* loc, I32 len));
 #endif
 void   my_exit _((U32 status)) __attribute__((noreturn));
-I32    my_lstat _((void));
+I32    my_lstat _((ARGSproto));
 #ifndef HAS_MEMCMP
 I32    my_memcmp _((unsigned char* s1, unsigned char* s2, I32 len));
 #endif
 I32    my_pclose _((FILE* ptr));
 FILE*  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));
@@ -288,7 +292,7 @@ FILE*       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));
@@ -299,7 +303,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));
@@ -321,21 +325,21 @@ 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   provide_ref _((OP* op, SV* sv));
-void   push_return _((OP* op));
+void   provide_ref _((OP* o, SV* sv));
+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));
-char*  regprop _((char* op));
+char*  regprop _((char* o));
 void   repeatcpy _((char* to, char* from, I32 len, I32 count));
 char*  rninstr _((char* big, char* bigend, char* little, char* lend));
 int    runops _((void));
@@ -367,7 +371,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));
 HV*    save_hash _((GV* gv));
 void   save_hptr _((HV** hptr));
@@ -383,9 +387,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));
 unsigned long  scan_hex _((char* start, I32 len, I32* retlen));
 char*  scan_num _((char* s));
 unsigned long  scan_oct _((char* start, I32 len, I32* retlen));
index d120eb7..b9cb327 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
 #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 */
@@ -1498,14 +1502,14 @@ regexp *r;
 - regprop - printable representation of opcode
 */
 char *
-regprop(op)
-char *op;
+regprop(o)
+char *o;
 {
     register char *p = 0;
 
     (void) strcpy(buf, ":");
 
-    switch (OP(op)) {
+    switch (OP(o)) {
     case BOL:
        p = "BOL";
        break;
@@ -1573,23 +1577,23 @@ char *op;
        p = "NDIGIT";
        break;
     case CURLY:
-       (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(op),ARG2(op));
+       (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(o),ARG2(o));
        p = NULL;
        break;
     case CURLYX:
-       (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(op),ARG2(op));
+       (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(o),ARG2(o));
        p = NULL;
        break;
     case REF:
-       (void)sprintf(buf+strlen(buf), "REF%d", ARG1(op));
+       (void)sprintf(buf+strlen(buf), "REF%d", ARG1(o));
        p = NULL;
        break;
     case OPEN:
-       (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op));
+       (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(o));
        p = NULL;
        break;
     case CLOSE:
-       (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op));
+       (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(o));
        p = NULL;
        break;
     case STAR:
index 6a29d7f..6c00651 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -89,6 +89,7 @@ CHECKPOINT
 regcppush(parenfloor)
 I32 parenfloor;
 {
+    dTHR;
     int retval = savestack_ix;
     int i = (regsize - parenfloor) * 3;
     int p;
@@ -110,6 +111,7 @@ I32 parenfloor;
 char*
 regcppop()
 {
+    dTHR;
     I32 i = SSPOPINT;
     U32 paren = 0;
     char *input;
@@ -771,6 +773,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 7c09f8f..dd178b9 100644 (file)
--- a/run.c
+++ b/run.c
@@ -23,19 +23,21 @@ dEXT char *watchok;
 
 int
 runops() {
+    dTHR;
     SAVEI32(runlevel);
     runlevel++;
 
-    while ( op = (*op->op_ppaddr)() ) ;
+    while ( op = (*op->op_ppaddr)(ARGS) ) ;
     return 0;
 }
 
 #else
 
-static void debprof _((OP*op));
+static void debprof _((OP*o));
 
 int
 runops() {
+    dTHR;
     if (!op) {
        warn("NULL OP IN RUN");
        return 0;
@@ -52,26 +54,29 @@ runops() {
            DEBUG_s(debstack());
            DEBUG_t(debop(op));
            DEBUG_P(debprof(op));
+#ifdef USE_THREADS
+           DEBUG_L(pthread_yield());   /* shake up scheduling a bit */
+#endif /* USE_THREADS */
        }
-    } while ( op = (*op->op_ppaddr)() );
+    } while ( op = (*op->op_ppaddr)(ARGS) );
     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:
-       fprintf(stderr, "(%s)", SvPEEK(cSVOP->op_sv));
+       fprintf(stderr, "(%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_fullname(sv, cGVOP->op_gv);
+           gv_fullname(sv, cGVOPo->op_gv);
            fprintf(stderr, "(%s)", SvPV(sv, na));
            SvREFCNT_dec(sv);
        }
@@ -96,12 +101,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 3f48609..035a493 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -21,6 +21,7 @@ SV** sp;
 SV** p;
 int n;
 {
+    dTHR;
     stack_sp = sp;
     av_extend(stack, (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 @@ SV *
 save_scalar(gv)
 GV *gv;
 {
+    dTHR;
     register SV *sv;
     SV *osv = GvSV(gv);
 
@@ -148,6 +158,7 @@ void
 save_gp(gv)
 GV *gv;
 {
+    dTHR;
     register GP *gp;
     GP *ogp = GvGP(gv);
 
@@ -169,6 +180,7 @@ SV*
 save_svref(sptr)
 SV **sptr;
 {
+    dTHR;
     register SV *sv;
     SV *osv = *sptr;
 
@@ -205,6 +217,7 @@ AV *
 save_ary(gv)
 GV *gv;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHPTR(gv);
     SSPUSHPTR(GvAVn(gv));
@@ -218,6 +231,7 @@ HV *
 save_hash(gv)
 GV *gv;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHPTR(gv);
     SSPUSHPTR(GvHVn(gv));
@@ -231,6 +245,7 @@ void
 save_item(item)
 register SV *item;
 {
+    dTHR;
     register SV *sv;
 
     SSCHECK(3);
@@ -245,6 +260,7 @@ void
 save_int(intp)
 int *intp;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHINT(*intp);
     SSPUSHPTR(intp);
@@ -255,6 +271,7 @@ void
 save_long(longp)
 long *longp;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHLONG(*longp);
     SSPUSHPTR(longp);
@@ -265,6 +282,7 @@ void
 save_I32(intp)
 I32 *intp;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHINT(*intp);
     SSPUSHPTR(intp);
@@ -275,6 +293,7 @@ void
 save_iv(ivp)
 IV *ivp;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHIV(*ivp);
     SSPUSHPTR(ivp);
@@ -288,6 +307,7 @@ void
 save_pptr(pptr)
 char **pptr;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHPTR(*pptr);
     SSPUSHPTR(pptr);
@@ -298,6 +318,7 @@ void
 save_sptr(sptr)
 SV **sptr;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHPTR(*sptr);
     SSPUSHPTR(sptr);
@@ -308,6 +329,7 @@ void
 save_nogv(gv)
 GV *gv;
 {
+    dTHR;
     SSCHECK(2);
     SSPUSHPTR(gv);
     SSPUSHINT(SAVEt_NSTAB);
@@ -317,6 +339,7 @@ void
 save_hptr(hptr)
 HV **hptr;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHPTR(*hptr);
     SSPUSHPTR(hptr);
@@ -327,6 +350,7 @@ void
 save_aptr(aptr)
 AV **aptr;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHPTR(*aptr);
     SSPUSHPTR(aptr);
@@ -337,17 +361,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);
 }
 
@@ -355,6 +381,7 @@ void
 save_freepv(pv)
 char *pv;
 {
+    dTHR;
     SSCHECK(2);
     SSPUSHPTR(pv);
     SSPUSHINT(SAVEt_FREEPV);
@@ -364,6 +391,7 @@ void
 save_clearsv(svp)
 SV** svp;
 {
+    dTHR;
     SSCHECK(2);
     SSPUSHLONG((long)(svp-curpad));
     SSPUSHINT(SAVEt_CLEARSV);
@@ -375,6 +403,7 @@ HV *hv;
 char *key;
 I32 klen;
 {
+    dTHR;
     SSCHECK(4);
     SSPUSHINT(klen);
     SSPUSHPTR(key);
@@ -387,6 +416,7 @@ save_list(sarg,maxsarg)
 register SV **sarg;
 I32 maxsarg;
 {
+    dTHR;
     register SV *sv;
     register I32 i;
 
@@ -405,6 +435,7 @@ save_destructor(f,p)
 void (*f) _((void*));
 void* p;
 {
+    dTHR;
     SSCHECK(3);
     SSPUSHDPTR(f);
     SSPUSHPTR(p);
@@ -415,6 +446,7 @@ void
 leave_scope(base)
 I32 base;
 {
+    dTHR;
     register SV *sv;
     register SV *value;
     register GV *gv;
@@ -612,6 +644,7 @@ void
 cx_dump(cx)
 CONTEXT* cx;
 {
+    dTHR;
     fprintf(stderr, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]);
     if (cx->cx_type != CXt_SUBST) {
        fprintf(stderr, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
diff --git a/sv.c b/sv.c
index a1f1d60..2a25a30 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -76,13 +76,17 @@ U32 flags;
 #else
 
 #define new_SV()                       \
-    if (sv_root) {                     \
-       sv = sv_root;                   \
-       sv_root = (SV*)SvANY(sv);       \
-       ++sv_count;                     \
-    }                                  \
-    else                               \
-       sv = more_sv();
+    do {                               \
+       MUTEX_LOCK(&sv_mutex);          \
+       if (sv_root) {                  \
+           sv = sv_root;               \
+           sv_root = (SV*)SvANY(sv);   \
+           ++sv_count;                 \
+       }                               \
+       else                            \
+           sv = more_sv();             \
+       MUTEX_UNLOCK(&sv_mutex);        \
+    } while (0)
 
 static SV*
 new_sv()
@@ -1026,8 +1030,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_name[op->op_type]);
+       {
+           dTHR;
+           croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
+                 op_name[op->op_type]);
+       }
     }
     (void)SvIOK_only(sv);                      /* validate number */
     SvIVX(sv) = i;
@@ -1074,8 +1081,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 */
@@ -1086,6 +1096,7 @@ static void
 not_a_number(sv)
 SV *sv;
 {
+    dTHR;
     char tmpbuf[64];
     char *d = tmpbuf;
     char *s;
@@ -1195,6 +1206,7 @@ register SV *sv;
        SvIVX(sv) = (IV)atol(SvPVX(sv));
     }
     else  {
+       dTHR;
        if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
            warn(warn_uninit);
        return 0;
@@ -1267,6 +1279,7 @@ register SV *sv;
        SvNVX(sv) = atof(SvPVX(sv));
     }
     else  {
+       dTHR;
        if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
            warn(warn_uninit);
        return 0.0;
@@ -1398,6 +1411,7 @@ STRLEN *lp;
        while (*s) s++;
     }
     else {
+       dTHR;
        if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
            warn(warn_uninit);
        *lp = 0;
@@ -1450,6 +1464,7 @@ register SV *sv;
     if (SvROK(sv)) {
 #ifdef OVERLOAD
       {
+       dTHR;
        SV* tmpsv;
        if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
          return SvTRUE(tmpsv);
@@ -1458,11 +1473,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;
@@ -1489,6 +1504,7 @@ sv_setsv(dstr,sstr)
 SV *dstr;
 register SV *sstr;
 {
+    dTHR;
     register U32 sflags;
     register int dtype;
     register int stype;
@@ -1622,6 +1638,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);
@@ -2021,6 +2038,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;
     }
@@ -2272,6 +2290,7 @@ register SV *sv;
     assert(SvREFCNT(sv) == 0);
 
     if (SvOBJECT(sv)) {
+       dTHR;
        dSP;
        GV* destructor;
 
@@ -2281,6 +2300,7 @@ register SV *sv;
            ENTER;
            SAVEFREESV(SvSTASH(sv));
            if (destructor && GvCV(destructor)) {
+               dTHR;
                SV ref;
 
                Zero(&ref, 1, SV);
@@ -2841,6 +2861,7 @@ register SV *sv;
 static void
 sv_mortalgrow()
 {
+    dTHR;
     tmps_max += 128;
     Renew(tmps_stack, tmps_max, SV*);
 }
@@ -2849,6 +2870,7 @@ SV *
 sv_mortalcopy(oldstr)
 SV *oldstr;
 {
+    dTHR;
     register SV *sv;
 
     new_SV();
@@ -2866,6 +2888,7 @@ SV *oldstr;
 SV *
 sv_newmortal()
 {
+    dTHR;
     register SV *sv;
 
     new_SV();
@@ -2884,6 +2907,7 @@ SV *
 sv_2mortal(sv)
 register SV *sv;
 {
+    dTHR;
     if (!sv)
        return sv;
     if (SvREADONLY(sv) && curcop != &compiling)
@@ -2944,6 +2968,7 @@ SV *
 newRV(ref)
 SV *ref;
 {
+    dTHR;
     register SV *sv;
 
     new_SV();
@@ -3205,9 +3230,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);
@@ -3296,6 +3323,7 @@ newSVrv(rv, classname)
 SV *rv;
 char *classname;
 {
+    dTHR;
     SV *sv;
 
     new_SV();
@@ -3362,6 +3390,7 @@ sv_bless(sv,stash)
 SV* sv;
 HV* stash;
 {
+    dTHR;
     SV *ref;
     if (!SvROK(sv))
         croak("Can't bless non-reference value");
@@ -3591,6 +3620,11 @@ SV* sv;
        fprintf(stderr, "  DEPTH = %ld\n", (long)CvDEPTH(sv));
        fprintf(stderr, "  PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
        fprintf(stderr, "  OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
+#ifdef USE_THREADS
+       fprintf(stderr, "  MUTEXP = 0x%lx\n", (long)CvMUTEXP(sv));
+       fprintf(stderr, "  CONDP = 0x%lx\n", (long)CvCONDP(sv));
+       fprintf(stderr, "  OWNER = 0x%lx\n", (long)CvOWNER(sv));
+#endif /* USE_THREADS */
        if (type == SVt_PVFM)
            fprintf(stderr, "  LINES = %ld\n", (long)FmLINES(sv));
        break;
diff --git a/sv.h b/sv.h
index c586de4..e87bb50 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -129,6 +129,10 @@ struct io {
 #define SVpbm_CASEFOLD 0x40000000
 #define SVpbm_TAIL     0x20000000
 
+#ifdef USE_THREADS
+#define SVpcv_SYNC     0x10000000      /* Synchronised: 1 thread at a time */
+#endif /* USE_THREADS */
+
 #ifdef OVERLOAD
 #define SVpgv_AM        0x40000000
 /* #define SVpgv_badAM     0x20000000 */
diff --git a/thread.h b/thread.h
new file mode 100644 (file)
index 0000000..4d6e4f0
--- /dev/null
+++ b/thread.h
@@ -0,0 +1,206 @@
+#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;
+};
+
+typedef struct thread *Thread;
+
+#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)
+#endif /* USE_THREADS */
diff --git a/toke.c b/toke.c
index 5a43c09..270cf45 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -326,6 +326,7 @@ static char *
 skipspace(s)
 register char *s;
 {
+    dTHR;
     if (lex_formbrack && lex_brackets <= lex_formbrack) {
        while (s < bufend && (*s == ' ' || *s == '\t'))
            s++;
@@ -500,11 +501,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;
            gv_fetchpv(s, TRUE,
                kind == '$' ? SVt_PV :
                kind == '@' ? SVt_PVAV :
@@ -1145,6 +1146,7 @@ extern int yychar;                /* last token */
 int
 yylex()
 {
+    dTHR;
     register char *s;
     register char *d;
     register I32 tmp;
@@ -1657,7 +1659,7 @@ yylex()
                    TERM('%');
                }
                if (!strchr(tokenbuf,':')) {
-                   if (tmp = pad_findmy(tokenbuf)) {
+                   if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
                        nextval[nexttoke].opval = newOP(OP_PADANY, 0);
                        nextval[nexttoke].opval->op_targ = tmp;
                        force_next(PRIVATEREF);
@@ -1969,7 +1971,7 @@ yylex()
                PREREF(DOLSHARP);
            if (!strchr(tokenbuf+1,':')) {
                tokenbuf[0] = '@';
-               if (tmp = pad_findmy(tokenbuf)) {
+               if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
                    nextval[nexttoke].opval = newOP(OP_PADANY, 0);
                    nextval[nexttoke].opval->op_targ = tmp;
                    expect = XOPERATOR;
@@ -2060,7 +2062,7 @@ yylex()
                            tokenbuf[0] = '%';
                    }
                }
-               if (tmp = pad_findmy(tokenbuf)) {
+               if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
                    if (!tokenbuf[2] && *tokenbuf =='$' &&
                        tokenbuf[1] <= 'b' && tokenbuf[1] >= 'a')
                    {
@@ -2113,7 +2115,7 @@ yylex()
                    if (*s == '{')
                        tokenbuf[0] = '%';
                }
-               if (tmp = pad_findmy(tokenbuf)) {
+               if (tmp = pad_findmy(tokenbuf) != NOT_IN_PAD) {
                    nextval[nexttoke].opval = newOP(OP_PADANY, 0);
                    nextval[nexttoke].opval->op_targ = tmp;
                    force_next(PRIVATEREF);
@@ -4334,6 +4336,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)
        ) {
@@ -4375,7 +4378,7 @@ scan_trans(start)
 char *start;
 {
     register char* s;
-    OP *op;
+    OP *o;
     short *tbl;
     I32 squash;
     I32 delete;
@@ -4405,7 +4408,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') {
@@ -4417,9 +4420,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;
 }
@@ -4428,6 +4431,7 @@ static char *
 scan_heredoc(s)
 register char *s;
 {
+    dTHR;
     SV *herewas;
     I32 op_type = OP_SCALAR;
     I32 len;
@@ -4575,10 +4579,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);
@@ -4602,6 +4606,7 @@ static char *
 scan_str(start)
 char *start;
 {
+    dTHR;
     SV *sv;
     char *tmps;
     register char *s = start;
@@ -4812,6 +4817,7 @@ static char *
 scan_formline(s)
 register char *s;
 {
+    dTHR;
     register char *eol;
     register char *t;
     SV *stuff = newSVpv("",0);
@@ -4890,6 +4896,7 @@ set_csh()
 int
 start_subparse()
 {
+    dTHR;
     int oldsavestack_ix = savestack_ix;
     CV* outsidecv = compcv;
     AV* comppadlist;
@@ -4915,6 +4922,9 @@ start_subparse()
     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);
@@ -4928,6 +4938,13 @@ start_subparse()
 
     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;
 }
@@ -4936,6 +4953,7 @@ int
 yywarn(s)
 char *s;
 {
+    dTHR;
     --error_count;
     in_eval |= 2;
     yyerror(s);
@@ -4947,6 +4965,7 @@ int
 yyerror(s)
 char *s;
 {
+    dTHR;
     char tmpbuf[258];
     char *tname = tmpbuf;
 
diff --git a/util.c b/util.c
index a11d98f..ef5c846 100644 (file)
--- a/util.c
+++ b/util.c
@@ -885,6 +885,7 @@ mess(pat, args)
     va_list *args;
 #endif
 {
+    dTHR;
     char *s;
     char *s_start;
     SV *tmpstr;
@@ -960,6 +961,7 @@ croak(pat, va_alist)
     va_dcl
 #endif
 {
+    dTHR;
     va_list args;
     char *message;
     HV *stash;
@@ -973,6 +975,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 && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
        dSP;
 
@@ -1030,6 +1035,7 @@ warn(pat,va_alist)
     va_end(args);
 
     if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+       dTHR;
        dSP;
 
        PUSHMARK(sp);
@@ -1810,3 +1816,17 @@ I32 *retlen;
     *retlen = s - start;
     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 */
+#endif /* USE_THREADS */