Avoid a run-time miniperl check every time SWASHNEW is called

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 296ded7..ef7be12 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -194,8 +194,7 @@ PP(pp_regcomp)
                PM_SETRE(pm, NULL);     /* crucial if regcomp aborts */
 #endif
            } else if (PL_curcop->cop_hints_hash) {
-               SV *ptr = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, 0,
-                                      "regcomp", 7, 0, 0);
+               SV *ptr = cop_hints_fetch_pvs(PL_curcop, "regcomp", 0);
                 if (ptr && SvIOK(ptr) && SvIV(ptr))
                     eng = INT2PTR(regexp_engine*,SvIV(ptr));
            }
@@ -1117,7 +1116,7 @@ PP(pp_mapwhile)
             * if necessary), then clear the current temps stack frame
             * *except* for those items. We do this splicing the items
             * into the start of the tmps frame (so some items may be on
-            * the tmps stack twice), then moving PL_stack_floor above
+            * the tmps stack twice), then moving PL_tmps_floor above
             * them, then freeing the frame. That way, the only tmps that
             * accumulate over iterations are the return values for map.
             * We have to do to this way so that everything gets correctly
@@ -1654,6 +1653,9 @@ Perl_die_unwind(pTHX_ SV *msv)
            SV *namesv;
            register PERL_CONTEXT *cx;
            SV **newsp;
+           COP *oldcop;
+           JMPENV *restartjmpenv;
+           OP *restartop;
 
            if (cxix < cxstack_ix)
                dounwind(cxix);
@@ -1668,6 +1670,9 @@ Perl_die_unwind(pTHX_ SV *msv)
            }
            POPEVAL(cx);
            namesv = cx->blk_eval.old_namesv;
+           oldcop = cx->blk_oldcop;
+           restartjmpenv = cx->blk_eval.cur_top_env;
+           restartop = cx->blk_eval.retop;
 
            if (gimme == G_SCALAR)
                *++newsp = &PL_sv_undef;
@@ -1679,7 +1684,7 @@ Perl_die_unwind(pTHX_ SV *msv)
             * XXX it might be better to find a way to avoid messing with
             * PL_curcop in save_re_context() instead, but this is a more
             * minimal fix --GSAR */
-           PL_curcop = cx->blk_oldcop;
+           PL_curcop = oldcop;
 
            if (optype == OP_REQUIRE) {
                 const char* const msg = SvPVx_nolen_const(exceptsv);
@@ -1700,9 +1705,8 @@ Perl_die_unwind(pTHX_ SV *msv)
            else {
                sv_setsv(ERRSV, exceptsv);
            }
-           assert(CxTYPE(cx) == CXt_EVAL);
-           PL_restartjmpenv = cx->blk_eval.cur_top_env;
-           PL_restartop = cx->blk_eval.retop;
+           PL_restartjmpenv = restartjmpenv;
+           PL_restartop = restartop;
            JMPENV_JUMP(3);
            /* NOTREACHED */
        }
@@ -1915,9 +1919,7 @@ PP(pp_caller)
     }
 
     PUSHs(cx->blk_oldcop->cop_hints_hash ?
-         sv_2mortal(newRV_noinc(
-                                MUTABLE_SV(Perl_refcounted_he_chain_2hv(aTHX_
-                                             cx->blk_oldcop->cop_hints_hash))))
+         sv_2mortal(newRV_noinc(MUTABLE_SV(cop_hints_2hv(cx->blk_oldcop, 0))))
          : &PL_sv_undef);
     RETURN;
 }
@@ -2229,7 +2231,6 @@ PP(pp_return)
        retop = cx->blk_eval.retop;
        if (CxTRYBLOCK(cx))
            break;
-       lex_end();
        if (optype == OP_REQUIRE &&
            (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
        {
@@ -2782,6 +2783,14 @@ PP(pp_goto)
                                    enterops, enterops + GOTO_DEPTH);
                if (retop)
                    break;
+               if (gotoprobe->op_sibling &&
+                       gotoprobe->op_sibling->op_type == OP_UNSTACK &&
+                       gotoprobe->op_sibling->op_sibling) {
+                   retop = dofindlabel(gotoprobe->op_sibling->op_sibling,
+                                       label, enterops, enterops + GOTO_DEPTH);
+                   if (retop)
+                       break;
+               }
            }
            PL_lastgotoprobe = gotoprobe;
        }
@@ -2993,7 +3002,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     PERL_ARGS_ASSERT_SV_COMPILE_2OP;
 
     ENTER_with_name("eval");
-    lex_start(sv, NULL);
+    lex_start(sv, NULL, 0);
     SAVETMPS;
     /* switch to eval mode */
 
@@ -3053,7 +3062,6 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
 
     (*startop)->op_type = OP_NULL;
     (*startop)->op_ppaddr = PL_ppaddr[OP_NULL];
-    lex_end();
     /* XXX DAPM do this properly one year */
     *padp = MUTABLE_AV(SvREFCNT_inc_simple(PL_comppad));
     LEAVE_with_name("eval");
@@ -3241,7 +3249,6 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
                namesv = cx->blk_eval.old_namesv;
            }
        }
-       lex_end();
        if (yystatus != 3)
            LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE.  */
 
@@ -3767,7 +3774,7 @@ PP(pp_require)
 
     ENTER_with_name("eval");
     SAVETMPS;
-    lex_start(NULL, tryrsfp);
+    lex_start(NULL, tryrsfp, 0);
 
     SAVEHINTS();
     PL_hints = 0;
@@ -3862,7 +3869,7 @@ PP(pp_entereval)
     TAINT_PROPER("eval");
 
     ENTER_with_name("eval");
-    lex_start(sv, NULL);
+    lex_start(sv, NULL, 0);
     SAVETMPS;
 
     /* switch to eval mode */
@@ -3895,25 +3902,18 @@ PP(pp_entereval)
     }
     SAVECOMPILEWARNINGS();
     PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
-    if (PL_compiling.cop_hints_hash) {
-       Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
-    }
+    cophh_free(CopHINTHASH_get(&PL_compiling));
     if (Perl_fetch_cop_label(aTHX_ PL_curcop, NULL, NULL)) {
        /* The label, if present, is the first entry on the chain. So rather
           than writing a blank label in front of it (which involves an
           allocation), just use the next entry in the chain.  */
        PL_compiling.cop_hints_hash
-           = PL_curcop->cop_hints_hash->refcounted_he_next;
+           = cophh_copy(PL_curcop->cop_hints_hash->refcounted_he_next);
        /* Check the assumption that this removed the label.  */
        assert(Perl_fetch_cop_label(aTHX_ &PL_compiling, NULL, NULL) == NULL);
     }
     else
-       PL_compiling.cop_hints_hash = PL_curcop->cop_hints_hash;
-    if (PL_compiling.cop_hints_hash) {
-       HINTS_REFCNT_LOCK;
-       PL_compiling.cop_hints_hash->refcounted_he_refcnt++;
-       HINTS_REFCNT_UNLOCK;
-    }
+       PL_compiling.cop_hints_hash = cophh_copy(PL_curcop->cop_hints_hash);
     /* special case: an eval '' executed within the DB package gets lexically
      * placed in the first non-DB CV rather than the current CV - this
      * allows the debugger to execute code, find lexicals etc, in the
@@ -4005,7 +4005,6 @@ PP(pp_leaveeval)
     assert(CvDEPTH(PL_compcv) == 1);
 #endif
     CvDEPTH(PL_compcv) = 0;
-    lex_end();
 
     if (optype == OP_REQUIRE &&
        !(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))