Fix multiple problems with lexical @_.

p4raw-id: //depot/perl@39

diff --git a/cop.h b/cop.h
index baedc5a..f49bfaf 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -28,7 +28,9 @@ struct block_sub {
     CV *       cv;
     GV *       gv;
     GV *       dfoutgv;
+#ifndef USE_THREADS
     AV *       savearray;
+#endif /* USE_THREADS */
     AV *       argarray;
     U16                olddepth;
     U8         hasargs;
@@ -54,11 +56,19 @@ struct block_sub {
 #define POPSUB1(cx)                                                    \
        cxsub = cx->blk_sub;    /* because DESTROY may clobber *cx */
 
+#ifdef USE_THREADS
+#define POPSAVEARRAY() NOOP
+#else
+#define POPSAVEARRAY()                                                 \
+    STMT_START {                                                       \
+       SvREFCNT_dec(GvAV(defgv));                                      \
+       GvAV(defgv) = cxsub.savearray;                                  \
+    } STMT_END
+#endif /* USE_THREADS */
+
 #define POPSUB2()                                                      \
        if (cxsub.hasargs) {                                            \
-           /* put back old @_ */                                       \
-           SvREFCNT_dec(GvAV(defgv));                                  \
-           GvAV(defgv) = cxsub.savearray;                              \
+           POPSAVEARRAY();                                             \
            /* destroy arg array */                                     \
            av_clear(cxsub.argarray);                                   \
            AvREAL_off(cxsub.argarray);                                 \

diff --git a/op.c b/op.c
index 3e5cf6e..20e1384 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4488,12 +4488,25 @@ OP *o;
     I32 type = o->op_type;
 
     if (!(o->op_flags & OPf_KIDS)) {
+       OP *argop;
+       
        op_free(o);
-       return newUNOP(type, 0,
-           scalar(newUNOP(OP_RV2AV, 0,
-               scalar(newGVOP(OP_GV, 0, subline 
-                              ? defgv 
-                              : gv_fetchpv("ARGV", TRUE, SVt_PVAV) )))));
+#ifdef USE_THREADS
+       if (subline) {
+           argop = newOP(OP_PADAV, OPf_REF);
+           argop->op_targ = 0;         /* curpad[0] is @_ */
+       }
+       else {
+           argop = newUNOP(OP_RV2AV, 0,
+               scalar(newGVOP(OP_GV, 0,
+                   gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
+       }
+#else
+       argop = newUNOP(OP_RV2AV, 0,
+           scalar(newGVOP(OP_GV, 0, subline ?
+                          defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
+#endif /* USE_THREADS */
+       return newUNOP(type, 0, scalar(argop));
     }
     return scalar(modkids(ck_fun(o), type));
 }

diff --git a/perl.c b/perl.c
index 3e8cee7..d3567f0 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -841,6 +841,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 #ifdef USE_THREADS
     av_store(comppad_name, 0, newSVpv("@_", 2));
     curpad[0] = (SV*)newAV();
+    SvPADMY_on(curpad[0]);     /* XXX Needed? */
     CvOWNER(compcv) = 0;
     New(666, CvMUTEXP(compcv), 1, pthread_mutex_t);
     MUTEX_INIT(CvMUTEXP(compcv));
@@ -2279,6 +2280,7 @@ dARGS
     cxstack_ix = -1;
 
     New(50,tmps_stack,128,SV*);
+    tmps_floor = -1;
     tmps_ix = -1;
     tmps_max = 128;
 

diff --git a/pp.c b/pp.c
index 735b884..c288a01 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3930,7 +3930,11 @@ PP(pp_split)
     if (pm->op_pmreplroot)
        ary = GvAVn((GV*)pm->op_pmreplroot);
     else if (gimme != G_ARRAY)
+#ifdef USE_THREADS
+       ary = (AV*)curpad[0];
+#else
        ary = GvAVn(defgv);
+#endif /* USE_THREADS */
     else
        ary = Nullav;
     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {

diff --git a/pp_ctl.c b/pp_ctl.c
index cd9a210..24cb7a3 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1742,8 +1742,10 @@ PP(pp_goto)
                EXTEND(stack_sp, items); /* @_ could have been extended. */
                Copy(AvARRAY(av), stack_sp, items, SV*);
                stack_sp += items;
+#ifndef USE_THREADS
                SvREFCNT_dec(GvAV(defgv));
                GvAV(defgv) = cx->blk_sub.savearray;
+#endif /* USE_THREADS */
                AvREAL_off(av);
                av_clear(av);
            }
@@ -1826,15 +1828,34 @@ PP(pp_goto)
                        svp = AvARRAY(padlist);
                    }
                }
+#ifdef USE_THREADS
+               if (!cx->blk_sub.hasargs) {
+                   AV* av = (AV*)curpad[0];
+                   
+                   items = AvFILL(av) + 1;
+                   if (items) {
+                       /* Mark is at the end of the stack. */
+                       EXTEND(sp, items);
+                       Copy(AvARRAY(av), sp + 1, items, SV*);
+                       sp += items;
+                       PUTBACK ;                   
+                   }
+               }
+#endif /* USE_THREADS */               
                SAVESPTR(curpad);
                curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
-               if (cx->blk_sub.hasargs) {
+#ifndef USE_THREADS
+               if (cx->blk_sub.hasargs)
+#endif /* USE_THREADS */
+               {
                    AV* av = (AV*)curpad[0];
                    SV** ary;
 
+#ifndef USE_THREADS
                    cx->blk_sub.savearray = GvAV(defgv);
-                   cx->blk_sub.argarray = av;
                    GvAV(defgv) = (AV*)SvREFCNT_inc(av);
+#endif /* USE_THREADS */
+                   cx->blk_sub.argarray = av;
                    ++mark;
 
                    if (items >= AvMAX(av) + 1) {
@@ -2149,15 +2170,17 @@ int gimme;
 #endif /* USE_THREADS */
 
     comppad = newAV();
+    av_push(comppad, Nullsv);
+    curpad = AvARRAY(comppad);
     comppad_name = newAV();
     comppad_name_fill = 0;
+    min_intro_pending = 0;
+    padix = 0;
 #ifdef USE_THREADS
     av_store(comppad_name, 0, newSVpv("@_", 2));
+    curpad[0] = (SV*)newAV();
+    SvPADMY_on(curpad[0]);     /* XXX Needed? */
 #endif /* USE_THREADS */
-    min_intro_pending = 0;
-    av_push(comppad, Nullsv);
-    curpad = AvARRAY(comppad);
-    padix = 0;
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);

diff --git a/pp_hot.c b/pp_hot.c
index 46f0032..f45fa68 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2024,8 +2024,14 @@ PP(pp_entersub)
                /* Need to copy @_ to stack. Alternative may be to
                 * switch stack to @_, and copy return values
                 * back. This would allow popping @_ in XSUB, e.g.. XXXX */
-               AV* av = GvAV(defgv);
-               I32 items = AvFILL(av) + 1;
+               AV* av;
+               I32 items;
+#ifdef USE_THREADS
+               av = (AV*)curpad[0];
+#else
+               av = GvAV(defgv);
+#endif /* USE_THREADS */               
+               items = AvFILL(av) + 1;
 
                if (items) {
                    /* Mark is at the end of the stack. */
@@ -2110,19 +2116,39 @@ PP(pp_entersub)
                svp = AvARRAY(padlist);
            }
        }
-       SAVESPTR(curpad);
-       curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
-       if (hasargs) {
+#ifdef USE_THREADS
+       if (!hasargs) {
            AV* av = (AV*)curpad[0];
+
+           items = AvFILL(av) + 1;
+           if (items) {
+               /* Mark is at the end of the stack. */
+               EXTEND(sp, items);
+               Copy(AvARRAY(av), sp + 1, items, SV*);
+               sp += items;
+               PUTBACK ;                   
+           }
+       }
+#endif /* USE_THREADS */               
+       SAVESPTR(curpad);
+       curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+#ifndef USE_THREADS
+       if (hasargs)
+#endif /* USE_THREADS */
+       {
+           AV* av;
            SV** ary;
 
+           av = (AV*)curpad[0];
            if (AvREAL(av)) {
                av_clear(av);
                AvREAL_off(av);
            }
+#ifndef USE_THREADS
            cx->blk_sub.savearray = GvAV(defgv);
-           cx->blk_sub.argarray = av;
            GvAV(defgv) = (AV*)SvREFCNT_inc(av);
+#endif /* USE_THREADS */
+           cx->blk_sub.argarray = av;
            ++MARK;
 
            if (items > AvMAX(av) + 1) {

diff --git a/t/op/do.t b/t/op/do.t
index db46237..87ec08d 100755 (executable)
--- a/t/op/do.t
+++ b/t/op/do.t
@@ -10,7 +10,7 @@ sub foo1
 
 sub foo2
 {
-    shift(_);
+    shift;
     print $_[0];
     $x = 'value';
     $x;

diff --git a/thread.h b/thread.h
index b207862..45e47c3 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -177,6 +177,10 @@ typedef struct condpair {
 #undef cxstack
 #undef cxstack_ix
 #undef cxstack_max
+#undef tmps_stack
+#undef tmps_floor
+#undef tmps_ix
+#undef tmps_max
 #undef curpad
 #undef Sv
 #undef Xpv

diff --git a/toke.c b/toke.c
index 705b9ab..54ad907 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5225,16 +5225,23 @@ U32 flags;
     CvFLAGS(compcv) |= flags;
 
     comppad = newAV();
+    av_push(comppad, Nullsv);
+    curpad = AvARRAY(comppad);
     comppad_name = newAV();
     comppad_name_fill = 0;
-#ifdef USE_THREADS
-    av_store(comppad_name, 0, newSVpv("@_", 2));
-#endif /* USE_THREADS */
     min_intro_pending = 0;
-    av_push(comppad, Nullsv);
-    curpad = AvARRAY(comppad);
     padix = 0;
     subline = curcop->cop_line;
+#ifdef USE_THREADS
+    av_store(comppad_name, 0, newSVpv("@_", 2));
+    curpad[0] = (SV*)newAV();
+    SvPADMY_on(curpad[0]);     /* XXX Needed? */
+    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 */
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);