Generate the optree for n-at-a-time for loops.

Perl_newFOROP can now also take an OP_LIST corresponding to two or more
lexicals to iterate over n-at-a-time, where those lexicals are all
declared in the for statement, and occupy consecutive pad slots.

1 files changed, 63 insertions, 4 deletions

diff --git a/op.c b/op.c
index 39eeabd122..db10de0216 100644
--- a/op.c
+++ b/op.c
@@ -10181,7 +10181,7 @@ Constructs, checks, and returns an op tree expressing a C<foreach>
 loop (iteration through a list of values).  This is a heavyweight loop,
 with structure that allows exiting the loop by C<last> and suchlike.
 
-C<sv> optionally supplies the variable that will be aliased to each
+C<sv> optionally supplies the variable(s) that will be aliased to each
 item in turn; if null, it defaults to C<$_>.
 C<expr> supplies the list of values to iterate over.  C<block> supplies
 the main body of the loop, and C<cont> optionally supplies a C<continue>
@@ -10201,8 +10201,9 @@ OP *
 Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
 {
     LOOP *loop;
-    OP *wop;
+    OP *iter;
     PADOFFSET padoff = 0;
+    PADOFFSET how_many_more = 0;
     I32 iterflags = 0;
     I32 iterpflags = 0;
 
@@ -10233,6 +10234,63 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
         }
         else if (sv->op_type == OP_NULL && sv->op_targ == OP_SREFGEN)
             NOOP;
+        else if (sv->op_type == OP_LIST) {
+            LISTOP *list = (LISTOP *) sv;
+            OP *pushmark = list->op_first;
+            OP *first_padsv;
+            UNOP *padsv;
+            PADOFFSET i;
+
+            iterpflags = OPpLVAL_INTRO; /* for my ($k, $v) () */
+
+            if (!pushmark || pushmark->op_type != OP_PUSHMARK) {
+                Perl_croak(aTHX_ "panic: newFORLOOP, found %s, expecting pushmark",
+                           pushmark ? PL_op_desc[pushmark->op_type] : "NULL");
+            }
+            first_padsv = OpSIBLING(pushmark);
+            if (!first_padsv || first_padsv->op_type != OP_PADSV) {
+                Perl_croak(aTHX_ "panic: newFORLOOP, found %s, expecting padsv",
+                           first_padsv ? PL_op_desc[first_padsv->op_type] : "NULL");
+            }
+            padoff = first_padsv->op_targ;
+
+            /* There should be at least one more PADSV to find, and the ops
+               should have consecutive values in targ: */
+            padsv = (UNOP *) OpSIBLING(first_padsv);
+            do {
+                if (!padsv || padsv->op_type != OP_PADSV) {
+                    Perl_croak(aTHX_ "panic: newFORLOOP, found %s at %lu, expecting padsv",
+                               padsv ? PL_op_desc[padsv->op_type] : "NULL",
+                               how_many_more);
+                }
+                ++how_many_more;
+                if (padsv->op_targ != padoff + how_many_more) {
+                    Perl_croak(aTHX_ "panic: newFORLOOP, padsv at %lu targ is %lu, not %lu",
+                               how_many_more, padsv->op_targ, padoff + how_many_more);
+                }
+
+                padsv = (UNOP *) OpSIBLING(padsv);
+            } while (padsv);
+
+            /* OK, this optree has the shape that we expected. So now *we*
+               "claim" the Pad slots: */
+            first_padsv->op_targ = 0;
+            PAD_COMPNAME_GEN_set(padoff, PERL_INT_MAX);
+
+            i = padoff;
+
+            padsv = (UNOP *) OpSIBLING(first_padsv);
+            do {
+                ++i;
+                padsv->op_targ = 0;
+                PAD_COMPNAME_GEN_set(i, PERL_INT_MAX);
+
+                padsv = (UNOP *) OpSIBLING(padsv);
+            } while (padsv);
+
+            op_free(sv);
+            sv = NULL;
+        }
         else
             Perl_croak(aTHX_ "Can't use %s for loop variable", PL_op_desc[sv->op_type]);
         if (padoff) {
@@ -10315,8 +10373,9 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
         OpLASTSIB_set(loop->op_last, (OP*)loop);
     }
     loop->op_targ = padoff;
-    wop = newWHILEOP(flags, 1, loop, newOP(OP_ITER, 0), block, cont, 0);
-    return wop;
+    iter = newOP(OP_ITER, 0);
+    iter->op_targ = how_many_more;
+    return newWHILEOP(flags, 1, loop, iter, block, cont, 0);
 }
 
 /*