[perl.git] branch blead, updated. v5.12.0-57-g339aac2

[Nicholas Clark]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/339aac22c2768aa840858c042e33fbf04d4f51ed?hp=d1515be42a17e7bb3fa584aea980f54524603f34>

- Log -----------------------------------------------------------------
commit 339aac22c2768aa840858c042e33fbf04d4f51ed
Author: Hugo van der Sanden <***@crypt.org>
Date: Thu Apr 15 13:05:38 2010 +0100

Avoid redundant reload of PL_op in the runloop.

(gcc, at least, generates suboptimal code without this dirty great hint)

M run.c

commit f410a2119920dd04690025a349e79575cfb9c972
Author: Nicholas Clark <***@ccl4.org>
Date: Thu Apr 15 11:37:53 2010 +0100

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.

M cop.h
M dump.c
M pp_ctl.c
M pp_hot.c
M run.c
M scope.c
-----------------------------------------------------------------------

Summary of changes:
cop.h | 1 +
dump.c | 1 -
pp_ctl.c | 7 +++++++
pp_hot.c | 7 +++++++
run.c | 4 ++--
scope.c | 2 ++
6 files changed, 19 insertions(+), 3 deletions(-)

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..eb465da 100644
--- a/run.c
+++ b/run.c
@@ -37,8 +37,8 @@ int
Perl_runops_standard(pTHX)
{
dVAR;
- while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
- PERL_ASYNC_CHECK();
+ register OP *op = PL_op;
+ while ((PL_op = op = CALL_FPTR(op->op_ppaddr)(aTHX))) {
}

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

--
Perl5 Master Repository

[Jerry D. Hedden]

Post by Nicholas Clark
commit f410a2119920dd04690025a349e79575cfb9c972
Date:   Thu Apr 15 11:37:53 2010 +0100
   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.

FYI,

Tests for my module Thread::Cancel started failing following this change.
The issue was my test threads used the following construct:

my $thr = threads->create(sub { while (1) { } });

When I tried sending signals to the thread, it didn't pick them up.
My fix was to make the 'test loop' more realistic.

sub test_loop
{
my $x = 1;
while ($x > 0) { threads->yield(); }
}

my $thr = threads->create('test_loop');