From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 15 Apr 2010 10:37:53 +0000 (+0100)
Subject: Move PERL_ASYNC_CHECK() from the runloop to control flow OPs.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f410a2119920dd04690025a349e79575cfb9c972;p=p5sagit%2Fp5-mst-13.2.git

Move PERL_ASYNC_CHECK() from the runloop to control flow OPs.

For the typical code this gives a 5% speedup, and removes the cost of "safe
signals". Tight looping code will show less gains, but should never be slower.

Subtle bugs might remain - there might be constructions that enter the runloop
(where signals used to be dispatched) but don't contain any PERL_ASYNC_CHECK()
calls themselves.
---

diff --git a/cop.h b/cop.h
index 6c51d73..420a5d1 100644
--- a/cop.h
+++ b/cop.h
@@ -592,6 +592,7 @@ struct block {
 /* Exit a block (RETURN and LAST). */
 #define POPBLOCK(cx,pm)							\
 	DEBUG_CX("POP");						\
+	PERL_ASYNC_CHECK();						\
 	cx = &cxstack[cxstack_ix--],					\
 	newsp		 = PL_stack_base + cx->blk_oldsp,		\
 	PL_curcop	 = cx->blk_oldcop,				\
diff --git a/dump.c b/dump.c
index bc1ba58..d1fa26e 100644
--- a/dump.c
+++ b/dump.c
@@ -2026,7 +2026,6 @@ Perl_runops_debug(pTHX)
 
     DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
     do {
-	PERL_ASYNC_CHECK();
 	if (PL_debug) {
 	    if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
 		PerlIO_printf(Perl_debug_log,
diff --git a/pp_ctl.c b/pp_ctl.c
index bbb2d15..e766d7d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -264,6 +264,9 @@ PP(pp_substcont)
     register REGEXP * const rx = cx->sb_rx;
     SV *nsv = NULL;
     REGEXP *old = PM_GETRE(pm);
+
+    PERL_ASYNC_CHECK();
+
     if(old != rx) {
 	if(old)
 	    ReREFCNT_dec(old);
@@ -1870,6 +1873,8 @@ PP(pp_dbstate)
     PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
     FREETMPS;
 
+    PERL_ASYNC_CHECK();
+
     if (PL_op->op_flags & OPf_SPECIAL /* breakpoint */
 	    || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace))
     {
@@ -2652,6 +2657,8 @@ PP(pp_goto)
     else
 	label = cPVOP->op_pv;
 
+    PERL_ASYNC_CHECK();
+
     if (label && *label) {
 	OP *gotoprobe = NULL;
 	bool leaving_eval = FALSE;
diff --git a/pp_hot.c b/pp_hot.c
index 70d3556..ff86b91 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -52,6 +52,7 @@ PP(pp_nextstate)
     TAINT_NOT;		/* Each statement is presumed innocent */
     PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
     FREETMPS;
+    PERL_ASYNC_CHECK();
     return NORMAL;
 }
 
@@ -98,6 +99,7 @@ PP(pp_gv)
 PP(pp_and)
 {
     dVAR; dSP;
+    PERL_ASYNC_CHECK();
     if (!SvTRUE(TOPs))
 	RETURN;
     else {
@@ -203,6 +205,7 @@ PP(pp_sassign)
 PP(pp_cond_expr)
 {
     dVAR; dSP;
+    PERL_ASYNC_CHECK();
     if (SvTRUEx(POPs))
 	RETURNOP(cLOGOP->op_other);
     else
@@ -416,6 +419,7 @@ PP(pp_preinc)
 PP(pp_or)
 {
     dVAR; dSP;
+    PERL_ASYNC_CHECK();
     if (SvTRUE(TOPs))
 	RETURN;
     else {
@@ -434,6 +438,7 @@ PP(pp_defined)
     const bool is_dor = (op_type == OP_DOR || op_type == OP_DORASSIGN);
 
     if (is_dor) {
+	PERL_ASYNC_CHECK();
         sv = TOPs;
         if (!sv || !SvANY(sv)) {
 	    if (op_type == OP_DOR)
@@ -2077,6 +2082,8 @@ PP(pp_subst)
 #endif
     SV *nsv = NULL;
 
+    PERL_ASYNC_CHECK();
+
     /* known replacement string? */
     register SV *dstr = (pm->op_pmflags & PMf_CONST) ? POPs : NULL;
     if (PL_op->op_flags & OPf_STACKED)
diff --git a/run.c b/run.c
index be280ee..20c711a 100644
--- a/run.c
+++ b/run.c
@@ -38,7 +38,6 @@ Perl_runops_standard(pTHX)
 {
     dVAR;
     while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
-	PERL_ASYNC_CHECK();
     }
 
     TAINT_NOT;
diff --git a/scope.c b/scope.c
index 2a9d2d0..6ee1254 100644
--- a/scope.c
+++ b/scope.c
@@ -1115,6 +1115,8 @@ Perl_leave_scope(pTHX_ I32 base)
     }
 
     PL_tainted = was;
+
+    PERL_ASYNC_CHECK();
 }
 
 void