Fixed bug where Time::HiRes::time returned time adjusted to
[p5sagit/p5-mst-13.2.git] / pp_hot.c
index a28337f..8c04a70 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -21,9 +21,9 @@
 
 /* Hot code. */
 
-#ifdef USE_THREADS
-static void unset_cvowner(pTHXo_ void *cvarg);
-#endif /* USE_THREADS */
+#ifdef USE_5005THREADS
+static void unset_cvowner(pTHX_ void *cvarg);
+#endif /* USE_5005THREADS */
 
 PP(pp_const)
 {
@@ -558,7 +558,10 @@ PP(pp_print)
        gv = (GV*)*++MARK;
     else
        gv = PL_defoutgv;
-    if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+
+    if (gv && (io = GvIO(gv))
+       && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+    {
       had_magic:
        if (MARK == ORIGMARK) {
            /* If using default handle then we need to make space to
@@ -570,7 +573,7 @@ PP(pp_print)
            ++SP;
        }
        PUSHMARK(MARK - 1);
-       *MARK = SvTIED_obj((SV*)gv, mg);
+       *MARK = SvTIED_obj((SV*)io, mg);
        PUTBACK;
        ENTER;
        call_method("PRINT", G_SCALAR);
@@ -582,8 +585,8 @@ PP(pp_print)
        RETURN;
     }
     if (!(io = GvIO(gv))) {
-        if ((GvEGV(gv))
-               && (mg = SvTIED_mg((SV*)GvEGV(gv), PERL_MAGIC_tiedscalar)))
+        if ((GvEGV(gv)) && (io = GvIO(GvEGV(gv)))
+           && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
             goto had_magic;
        if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
            report_evil_fh(gv, io, PL_op->op_type);
@@ -1219,7 +1222,7 @@ PP(pp_match)
        TARG = DEFSV;
        EXTEND(SP,1);
     }
-    PL_reg_sv = TARG;
+
     PUTBACK;                           /* EVAL blocks need stack_sp. */
     s = SvPV(TARG, len);
     strend = s + len;
@@ -1229,6 +1232,8 @@ PP(pp_match)
                 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
 
+    PL_reg_match_utf8 = DO_UTF8(TARG);
+
     if (pm->op_pmdynflags & PMdf_USED) {
       failure:
        if (gimme == G_ARRAY)
@@ -1328,11 +1333,27 @@ play_it_again:
                len = rx->endp[i] - rx->startp[i];
                s = rx->startp[i] + truebase;
                sv_setpvn(*SP, s, len);
-               if (DO_UTF8(TARG))
+               if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
                    SvUTF8_on(*SP);
            }
        }
        if (global) {
+           if (pm->op_pmflags & PMf_CONTINUE) {
+               MAGIC* mg = 0;
+               if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
+                   mg = mg_find(TARG, PERL_MAGIC_regex_global);
+               if (!mg) {
+                   sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0);
+                   mg = mg_find(TARG, PERL_MAGIC_regex_global);
+               }
+               if (rx->startp[0] != -1) {
+                   mg->mg_len = rx->endp[0];
+                   if (rx->startp[0] == rx->endp[0])
+                       mg->mg_flags |= MGf_MINMATCH;
+                   else
+                       mg->mg_flags &= ~MGf_MINMATCH;
+               }
+           }
            had_zerolen = (rx->startp[0] != -1
                           && rx->startp[0] == rx->endp[0]);
            PUTBACK;                    /* EVAL blocks may use stack */
@@ -1379,7 +1400,7 @@ yup:                                      /* Confirmed by INTUIT */
     if (global) {
        rx->subbeg = truebase;
        rx->startp[0] = s - truebase;
-       if (DO_UTF8(PL_reg_sv)) {
+       if (PL_reg_match_utf8) {
            char *t = (char*)utf8_hop((U8*)s, rx->minlen);
            rx->endp[0] = t - truebase;
        }
@@ -1434,9 +1455,9 @@ Perl_do_readline(pTHX)
     I32 gimme = GIMME_V;
     MAGIC *mg;
 
-    if ((mg = SvTIED_mg((SV*)PL_last_in_gv, PERL_MAGIC_tiedscalar))) {
+    if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
        PUSHMARK(SP);
-       XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
+       XPUSHs(SvTIED_obj((SV*)io, mg));
        PUTBACK;
        ENTER;
        call_method("READLINE", gimme);
@@ -1769,7 +1790,7 @@ PP(pp_iter)
            STRLEN maxlen;
            char *max = SvPV((SV*)av, maxlen);
            if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
-#ifndef USE_THREADS                      /* don't risk potential race */
+#ifndef USE_5005THREADS                          /* don't risk potential race */
                if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
                    /* safe to reuse old SV */
                    sv_setsv(*itersvp, cur);
@@ -1795,7 +1816,7 @@ PP(pp_iter)
        if (cx->blk_loop.iterix > cx->blk_loop.itermax)
            RETPUSHNO;
 
-#ifndef USE_THREADS                      /* don't risk potential race */
+#ifndef USE_5005THREADS                          /* don't risk potential race */
        if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
            /* safe to reuse old SV */
            sv_setiv(*itersvp, cx->blk_loop.iterix++);
@@ -1879,7 +1900,6 @@ PP(pp_subst)
     STRLEN len;
     int force_on_match = 0;
     I32 oldsave = PL_savestack_ix;
-    bool do_utf8;
     STRLEN slen;
 
     /* known replacement string? */
@@ -1890,8 +1910,7 @@ PP(pp_subst)
        TARG = DEFSV;
        EXTEND(SP,1);
     }
-    PL_reg_sv = TARG;
-    do_utf8 = DO_UTF8(PL_reg_sv);
+
     if (SvFAKE(TARG) && SvREADONLY(TARG))
        sv_force_normal(TARG);
     if (SvREADONLY(TARG)
@@ -1909,12 +1928,14 @@ PP(pp_subst)
        rxtainted |= 2;
     TAINT_NOT;
 
+    PL_reg_match_utf8 = DO_UTF8(TARG);
+
   force_it:
     if (!pm || !s)
        DIE(aTHX_ "panic: pp_subst");
 
     strend = s + len;
-    slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : len;
+    slen = PL_reg_match_utf8 ? utf8_length((U8*)s, (U8*)strend) : len;
     maxiters = 2 * slen + 10;  /* We can match twice at each
                                   position, once with zero-length,
                                   second time with non-zero. */
@@ -2444,6 +2465,8 @@ PP(pp_entersub)
            }
            if (SvGMAGICAL(sv)) {
                mg_get(sv);
+               if (SvROK(sv))
+                   goto got_rv;
                sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
            }
            else
@@ -2455,6 +2478,7 @@ PP(pp_entersub)
            cv = get_cv(sym, TRUE);
            break;
        }
+  got_rv:
        {
            SV **sp = &sv;              /* Used in tryAMAGICunDEREF macro. */
            tryAMAGICunDEREF(to_cv);
@@ -2516,11 +2540,6 @@ try_autoload:
        goto retry;
     }
 
-    if(CvDEFSTASH(cv) != PL_defstash) {
-        save_hptr(&PL_defstash);
-       PL_defstash = CvDEFSTASH(cv);
-    }
-
     gimme = GIMME_V;
     if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
        cv = get_db_sub(&sv, cv);
@@ -2528,7 +2547,7 @@ try_autoload:
            DIE(aTHX_ "No DBsub routine");
     }
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     /*
      * First we need to check if the sub or method requires locking.
      * If so, we gain a lock on the CV, the first argument or the
@@ -2660,7 +2679,7 @@ try_autoload:
            SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv);
        }
     }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     if (CvXSUB(cv)) {
 #ifdef PERL_XSUB_OLDSTYLE
@@ -2693,11 +2712,11 @@ try_autoload:
                 * back. This would allow popping @_ in XSUB, e.g.. XXXX */
                AV* av;
                I32 items;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
                av = (AV*)PL_curpad[0];
 #else
                av = GvAV(PL_defgv);
-#endif /* USE_THREADS */               
+#endif /* USE_5005THREADS */           
                items = AvFILLp(av) + 1;   /* @_ is not tieable */
 
                if (items) {
@@ -2715,7 +2734,7 @@ try_autoload:
                PL_curcopdb = NULL;
            }
            /* Do we need to open block here? XXXX */
-           (void)(*CvXSUB(cv))(aTHXo_ cv);
+           (void)(*CvXSUB(cv))(aTHX_ cv);
 
            /* Enforce some sanity in scalar context. */
            if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) {
@@ -2789,7 +2808,7 @@ try_autoload:
                svp = AvARRAY(padlist);
            }
        }
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
        if (!hasargs) {
            AV* av = (AV*)PL_curpad[0];
 
@@ -2802,12 +2821,12 @@ try_autoload:
                PUTBACK ;               
            }
        }
-#endif /* USE_THREADS */               
+#endif /* USE_5005THREADS */           
        SAVEVPTR(PL_curpad);
        PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
-#ifndef USE_THREADS
+#ifndef USE_5005THREADS
        if (hasargs)
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
        {
            AV* av;
            SV** ary;
@@ -2824,10 +2843,10 @@ try_autoload:
                AvREAL_off(av);
                AvREIFY_on(av);
            }
-#ifndef USE_THREADS
+#ifndef USE_5005THREADS
            cx->blk_sub.savearray = GvAV(PL_defgv);
            GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
            cx->blk_sub.oldcurpad = PL_curpad;
            cx->blk_sub.argarray = av;
            ++MARK;
@@ -3110,9 +3129,9 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
 }
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 static void
-unset_cvowner(pTHXo_ void *cvarg)
+unset_cvowner(pTHX_ void *cvarg)
 {
     register CV* cv = (CV *) cvarg;
 
@@ -3127,4 +3146,4 @@ unset_cvowner(pTHXo_ void *cvarg)
     MUTEX_UNLOCK(CvMUTEXP(cv));
     SvREFCNT_dec(cv);
 }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */