make "for my $lex {}" faster under ITHREADS

Normally at the start of a 'for' iteration (pp_enteriter), we store the
address of the GV or the address of the pad slot of the iteration variable
in the CX struct, so we can quickly access and update it in pp_iter.  For
the ITHREADS case however, the pad may change if the thread is cloned, so
instead the address of PL_comppad was stored, and then updated during
cloning. This meant that on each iter, we would have to retrieve the saved
PL_comppad address from the ctx struct, retrieve the targ from the saved
my_op, and do a (perlish) array indexing.

Thuis commit makes this faster by, for the ITHREADS case, storing both
PL_comppad and svp = &PLcurpad[targ]. In pp_iter(), we're fast by directly
accessing *svp; while storing PL_comppad allows us to update both it and
svp during thread cloning.

This requires one extra pointer in the block_loop part of the context
union under threads, but this is already smaller than some other parts of
the union, so has no effect.

Note that the oldcomppad field was formerly part of the itervar_u union,
but is now a separate field within the larger block_loop struct (but only
on threaded builds).

Note also that the tests I've added I retrieved from an old WIP private
branch that contained a forerunner of this commit, so they may not be
entirely relevant to the current form of this commit. But extra tests
can never hurt, so I've included them.

diff --git a/cop.h b/cop.h
index 34c21f0..02885d9 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -746,9 +746,8 @@ struct block_loop {
     I32                resetsp;
     LOOP *     my_op;  /* My op, that contains redo, next and last ops.  */
     union {    /* different ways of locating the iteration variable */
-       SV      **svp;
-       GV      *gv;
-       PAD     *oldcomppad; /* only used in ITHREADS */
+       SV      **svp; /* for lexicals: address of pad slot */
+       GV      *gv;   /* for package vars */
     } itervar_u;
     union {
        struct { /* valid if type is LOOP_FOR or LOOP_PLAIN (but {NULL,0})*/
@@ -764,23 +763,19 @@ struct block_loop {
            SV * end; /* maxiumum value (or minimum in reverse) */
        } lazysv;
     } state_u;
-};
-
 #ifdef USE_ITHREADS
-#  define CxITERVAR_PADSV(c) \
-       &CX_CURPAD_SV( (c)->blk_loop.itervar_u, (c)->blk_loop.my_op->op_targ)
-#else
-#  define CxITERVAR_PADSV(c) ((c)->blk_loop.itervar_u.svp)
+    PAD *oldcomppad; /* needed to map itervar_u.svp during thread clone */
 #endif
+};
 
 #define CxITERVAR(c)                                                   \
-       ((c)->blk_loop.itervar_u.oldcomppad                             \
-        ? (CxPADLOOP(c)                                                \
-           ? CxITERVAR_PADSV(c)                                        \
-           : isGV((c)->blk_loop.itervar_u.gv)                          \
-               ? &GvSV((c)->blk_loop.itervar_u.gv)                     \
-               : (SV **)&(c)->blk_loop.itervar_u.gv)                   \
-        : (SV**)NULL)
+        (CxPADLOOP(c)                                                  \
+            ? (c)->blk_loop.itervar_u.svp                              \
+            : (c)->blk_loop.itervar_u.svp                              \
+                ? isGV((c)->blk_loop.itervar_u.gv)                     \
+                    ? &GvSV((c)->blk_loop.itervar_u.gv)                        \
+                    : (SV **)&(c)->blk_loop.itervar_u.gv               \
+                : (SV**)NULL)
 
 #define CxLABEL(c)     (0 + CopLABEL((c)->blk_oldcop))
 #define CxLABEL_len(c,len)     (0 + CopLABEL_len((c)->blk_oldcop, len))
@@ -798,12 +793,19 @@ struct block_loop {
        cx->blk_loop.state_u.ary.ix = 0;                                \
        cx->blk_loop.itervar_u.svp = NULL;
 
+#ifdef USE_ITHREADS
+#  define PUSHLOOP_FOR_setpad(c) (c)->blk_loop.oldcomppad = PL_comppad
+#else
+#  define PUSHLOOP_FOR_setpad(c) NOOP
+#endif
+
 #define PUSHLOOP_FOR(cx, ivar, s)                                      \
        cx->blk_loop.resetsp = s - PL_stack_base;                       \
        cx->blk_loop.my_op = cLOOP;                                     \
        cx->blk_loop.state_u.ary.ary = NULL;                            \
        cx->blk_loop.state_u.ary.ix = 0;                                \
-       cx->blk_loop.itervar_u.svp = (SV**)(ivar);
+       cx->blk_loop.itervar_u.svp = (SV**)(ivar);                      \
+        PUSHLOOP_FOR_setpad(cx);
 
 #define POPLOOP(cx)                                                    \
        if (CxTYPE(cx) == CXt_LOOP_LAZYSV) {                            \

diff --git a/ext/XS-APItest/t/clone-with-stack.t b/ext/XS-APItest/t/clone-with-stack.t
index 179fba0..10fa036 100644 (file)
--- a/ext/XS-APItest/t/clone-with-stack.t
+++ b/ext/XS-APItest/t/clone-with-stack.t
@@ -17,7 +17,7 @@ if (not $Config{'useithreads'}) {
     skip_all("clone_with_stack requires threads");
 }
 
-plan(6);
+plan(8);
 
 fresh_perl_is( <<'----', <<'====', undef, "minimal clone_with_stack" );
 use XS::APItest;
@@ -101,3 +101,52 @@ hsh: hale
 ====
 
 }
+
+{
+    fresh_perl_is( <<'----', <<'====', undef, "inside a loop inside a fn" );
+use XS::APItest;
+my $a = 'aa';
+sub f {
+    my $b = 'bb';
+    my @c;
+    my $d = 'dd';
+    for my $d (0..4) {
+       clone_with_stack() if $d == 2;
+       push @c, $d;
+    }
+    return @c, $d;
+}
+print "X-$a-", join(':', f()), "-Z\n";
+----
+X-aa-0:1:2:3:4:dd-Z
+====
+
+}
+
+{
+    fresh_perl_is( <<'----', <<'====', undef, "inside fn inside a loop inside a fn" );
+use XS::APItest;
+my $a = 'aa';
+
+sub g {
+    my $e = 'ee';
+    my $f = 'ff';
+    clone_with_stack();
+}
+
+sub f {
+    my $b = 'bb';
+    my @c;
+    my $d = 'dd';
+    for my $d (0..4) {
+       g() if $d == 2;
+       push @c, $d;
+    }
+    return @c, $d;
+}
+print "X-$a-", join(':', f()), "-Z\n";
+----
+X-aa-0:1:2:3:4:dd-Z
+====
+
+}

diff --git a/pp_ctl.c b/pp_ctl.c
index a89688a..8d21db7 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2121,11 +2121,7 @@ PP(pp_enteriter)
                    SVs_PADSTALE, SVs_PADSTALE);
        }
        SAVEPADSVANDMORTALIZE(PL_op->op_targ);
-#ifdef USE_ITHREADS
-       itervar = PL_comppad;
-#else
        itervar = &PAD_SVl(PL_op->op_targ);
-#endif
     }
     else if (LIKELY(isGV(TOPs))) {             /* symbol table variable */
        GV * const gv = MUTABLE_GV(POPs);

diff --git a/sv.c b/sv.c
index ac64dfb..15c0c54 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -13979,10 +13979,16 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
            case CXt_LOOP_PLAIN:
                 /* code common to all CXt_LOOP_* types */
                if (CxPADLOOP(ncx)) {
-                   ncx->blk_loop.itervar_u.oldcomppad
-                       = (PAD*)ptr_table_fetch(PL_ptr_table,
-                                       ncx->blk_loop.itervar_u.oldcomppad);
-               } else {
+                    PADOFFSET off = ncx->blk_loop.itervar_u.svp
+                                    - &CX_CURPAD_SV(ncx->blk_loop, 0);
+                    ncx->blk_loop.oldcomppad =
+                                    (PAD*)ptr_table_fetch(PL_ptr_table,
+                                                ncx->blk_loop.oldcomppad);
+                   ncx->blk_loop.itervar_u.svp =
+                                    &CX_CURPAD_SV(ncx->blk_loop, off);
+
+                }
+               else {
                    ncx->blk_loop.itervar_u.gv
                        = gv_dup((const GV *)ncx->blk_loop.itervar_u.gv,
                                    param);

diff --git a/t/op/for.t b/t/op/for.t
index 1f4cbf3..922e3da 100644 (file)
--- a/t/op/for.t
+++ b/t/op/for.t
@@ -5,7 +5,7 @@ BEGIN {
     require "./test.pl";
 }
 
-plan(109);
+plan(110);
 
 # A lot of tests to check that reversed for works.
 
@@ -597,3 +597,15 @@ for my $x (my $y) {
 @_ = (1,2,3,scalar do{for(@_){}} + 1, 4, 5, 6);
 is "@_", "1 2 3 1 4 5 6",
    '[perl #124004] scalar for(@empty_array) stack bug';
+
+# DAPM: while messing with the scope code, I broke some cpan/ code,
+# but surprisingly didn't break any dedicated tests. So test it:
+
+sub fscope {
+    for my $y (1,2) {
+       my $a = $y;
+       return $a;
+    }
+}
+
+is(fscope(), 1, 'return via loop in sub');

diff --git a/t/perf/benchmarks b/t/perf/benchmarks
index ce8f19e..fa7b54c 100644 (file)
--- a/t/perf/benchmarks
+++ b/t/perf/benchmarks
@@ -827,7 +827,13 @@
         desc    => '$x--',
         setup   => 'my $x = 1; my $y',
         code    => '$y = $x--', # scalar context so not optimised to --$x
+    },
+
 
+    'loop::for_my_range' => {
+        desc    => 'empty for loop with my var and integer range',
+        setup   => '',
+        code    => 'for my $x (1..10) {}',
     },
 
 ];