[win32] integrate mainline

[p5sagit/p5-mst-13.2.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 633a7b0..2fba24a 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -65,7 +65,7 @@ PP(pp_nextstate)
 PP(pp_gvsv)
 {
     djSP;
-    EXTEND(sp,1);
+    EXTEND(SP,1);
     if (op->op_private & OPpLVAL_INTRO)
        PUSHs(save_scalar(cGVOP->op_gv));
     else
@@ -644,8 +644,15 @@ PP(pp_aassign)
                    }
                    TAINT_NOT;
                }
-               if (relem == lastrelem && dowarn)
-                   warn("Odd number of elements in hash list");
+               if (relem == lastrelem && dowarn) {
+                   if (relem == firstrelem &&
+                       SvROK(*relem) &&
+                       ( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
+                         SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
+                       warn("Reference found where even-sized list expected");
+                   else
+                       warn("Odd number of elements in hash assignment");
+               }
            }
            break;
        default:
@@ -1059,7 +1066,7 @@ do_readline(void)
                       ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
                       but that's unsupported, so I don't want to do it now and
                       have it bite someone in the future. */
-                   strcat(tmpfnam,tmpnam(NULL));
+                   strcat(tmpfnam,PerlLIO_tmpnam(NULL));
                    cp = SvPV(tmpglob,i);
                    for (; i; i--) {
                       if (cp[i] == ';') hasver = 1;
@@ -1077,7 +1084,10 @@ do_readline(void)
                       }
                    }
                    if ((tmpfp = PerlIO_open(tmpfnam,"w+","fop=dlt")) != NULL) {
-                       ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
+                       Stat_t st;
+                       if (!PerlLIO_stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode))
+                         ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL);
+                       else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
                        if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
                        while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
                                                    &dfltdsc,NULL,NULL,NULL))&1)) {
@@ -1224,7 +1234,7 @@ do_readline(void)
                if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
                    strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
                        break;
-           if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
+           if (*tmps && PerlLIO_stat(SvPVX(sv), &statbuf) < 0) {
                (void)POPs;             /* Unmatched wildcard?  Chuck it... */
                continue;
            }
@@ -1265,7 +1275,7 @@ PP(pp_enter)
     ENTER;
 
     SAVETMPS;
-    PUSHBLOCK(cx, CXt_BLOCK, sp);
+    PUSHBLOCK(cx, CXt_BLOCK, SP);
 
     RETURN;
 }
@@ -1310,7 +1320,7 @@ PP(pp_helem)
            if (HvNAME(hv) && isGV(*svp))
                save_gp((GV*)*svp, !(op->op_flags & OPf_SPECIAL));
            else
-               save_svref(svp);
+               save_helem(hv, keysv, svp);
        }
        else if (op->op_private & OPpDEREF)
            vivify_ref(*svp, op->op_private & OPpDEREF);
@@ -1382,7 +1392,7 @@ PP(pp_iter)
     SV* sv;
     AV* av;
 
-    EXTEND(sp, 1);
+    EXTEND(SP, 1);
     cx = &cxstack[cxstack_ix];
     if (cx->cx_type != CXt_LOOP)
        DIE("panic: pp_iter");
@@ -1714,7 +1724,7 @@ PP(pp_grepwhile)
     LEAVE;                                     /* exit inner scope */
 
     /* All done yet? */
-    if (stack_base + *markstack_ptr > sp) {
+    if (stack_base + *markstack_ptr > SP) {
        I32 items;
        I32 gimme = GIMME_V;
 
@@ -1790,27 +1800,35 @@ static CV *
 get_db_sub(SV **svp, CV *cv)
 {
     dTHR;
-    SV *oldsv = *svp;
-    GV *gv;
+    SV *dbsv = GvSV(DBsub);
 
-    *svp = GvSV(DBsub);
-    save_item(*svp);
-    gv = CvGV(cv);
-    if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
-        || strEQ(GvNAME(gv), "END") 
-        || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
-            !( (SvTYPE(oldsv) == SVt_PVGV) && (GvCV((GV*)oldsv) == cv)
-               && (gv = (GV*)oldsv) ))) {
-       /* Use GV from the stack as a fallback. */
-       /* GV is potentially non-unique, or contain different CV. */
-       sv_setsv(*svp, newRV((SV*)cv));
+    if (!PERLDB_SUB_NN) {
+       GV *gv = CvGV(cv);
+
+       save_item(dbsv);
+       if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+            || strEQ(GvNAME(gv), "END") 
+            || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
+                !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv)
+                   && (gv = (GV*)*svp) ))) {
+           /* Use GV from the stack as a fallback. */
+           /* GV is potentially non-unique, or contain different CV. */
+           sv_setsv(dbsv, newRV((SV*)cv));
+       }
+       else {
+           gv_efullname3(dbsv, gv, Nullch);
+       }
     }
     else {
-       gv_efullname3(*svp, gv, Nullch);
+       SvUPGRADE(dbsv, SVt_PVIV);
+       SvIOK_on(dbsv);
+       SAVEIV(SvIVX(dbsv));
+       SvIVX(dbsv) = (IV)cv;           /* Do it the quickest way  */
     }
-    cv = GvCV(DBsub);
+
     if (CvXSUB(cv))
        curcopdb = curcop;
+    cv = GvCV(DBsub);
     return cv;
 }
 
@@ -1979,8 +1997,9 @@ PP(pp_entersub)
         * (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(thr->cvcache, (char *)cv, sizeof(cv), FALSE);
-       if (svp) {
+       if (threadnum &&
+           (svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
+       {
            /* We already have a clone to use */
            MUTEX_UNLOCK(CvMUTEXP(cv));
            cv = *(CV**)svp;
@@ -2032,17 +2051,15 @@ PP(pp_entersub)
     }
 #endif /* USE_THREADS */
 
-    gimme = GIMME;
-
     if (CvXSUB(cv)) {
        if (CvOLDSTYLE(cv)) {
            I32 (*fp3)_((int,int,int));
            dMARK;
            register I32 items = SP - MARK;
                                        /* We dont worry to copy from @_. */
-           while (sp > mark) {
-               sp[1] = sp[0];
-               sp--;
+           while (SP > mark) {
+               SP[1] = SP[0];
+               SP--;
            }
            stack_sp = mark + 1;
            fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
@@ -2071,9 +2088,9 @@ PP(pp_entersub)
 
                if (items) {
                    /* Mark is at the end of the stack. */
-                   EXTEND(sp, items);
-                   Copy(AvARRAY(av), sp + 1, items, SV*);
-                   sp += items;
+                   EXTEND(SP, items);
+                   Copy(AvARRAY(av), SP + 1, items, SV*);
+                   SP += items;
                    PUTBACK ;               
                }
            }
@@ -2159,9 +2176,9 @@ PP(pp_entersub)
            items = AvFILLp(av) + 1;
            if (items) {
                /* Mark is at the end of the stack. */
-               EXTEND(sp, items);
-               Copy(AvARRAY(av), sp + 1, items, SV*);
-               sp += items;
+               EXTEND(SP, items);
+               Copy(AvARRAY(av), SP + 1, items, SV*);
+               SP += items;
                PUTBACK ;                   
            }
        }
@@ -2263,7 +2280,7 @@ PP(pp_aelem)
            RETURN;
        }
        if (op->op_private & OPpLVAL_INTRO)
-           save_svref(svp);
+           save_aelem(av, elem, svp);
        else if (op->op_private & OPpDEREF)
            vivify_ref(*svp, op->op_private & OPpDEREF);
     }
@@ -2288,7 +2305,7 @@ vivify_ref(SV *sv, U32 to_what)
        }
        switch (to_what) {
        case OPpDEREF_SV:
-           SvRV(sv) = newSV(0);
+           SvRV(sv) = NEWSV(355,0);
            break;
        case OPpDEREF_AV:
            SvRV(sv) = (SV*)newAV();