Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups.
[perl.git] / pp_ctl.c
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);
 }