Optimize foreach (1..1000000)

	Message-ID: <m3lnqmwt93.fsf@furu.g.aas.no>

p4raw-id: //depot/perl@1239

diff --git a/Todo b/Todo
index e9263cc..3e137f9 100644 (file)
--- a/Todo
+++ b/Todo
@@ -32,7 +32,6 @@ Optimizations
        constant function cache
        switch structures
        eval qw() at compile time
-       foreach (1..1000000)
        foreach(reverse...)
        Set KEEP on constant split
        Cache eval tree (unless lexical outer scope used (mark in &compiling?))

diff --git a/cop.h b/cop.h
index 803be29..4e14c88 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -114,7 +114,8 @@ struct block_loop {
     SV *       itersave;
     SV *       iterlval;
     AV *       iterary;
-    I32                iterix;
+    IV         iterix;
+    IV         itermax;
 };
 
 #define PUSHLOOP(cx, ivar, s)                                          \

diff --git a/op.c b/op.c
index d390205..530c29d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3024,12 +3024,44 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
 #endif
     }
     if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
-       expr = scalar(ref(expr, OP_ITER));
+       expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
        iterflags |= OPf_STACKED;
     }
+    else if (expr->op_type == OP_NULL &&
+             (expr->op_flags & OPf_KIDS) &&
+             ((BINOP*)expr)->op_first->op_type == OP_FLOP)
+    {
+       /* Basically turn for($x..$y) into the same as for($x,$y), but we
+        * set the STACKED flag to indicate that these values are to be
+        * treated as min/max values by 'pp_iterinit'.
+        */
+       UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
+       CONDOP* range = (CONDOP*) flip->op_first;
+       OP* left  = range->op_first;
+       OP* right = left->op_sibling;
+       LISTOP* list;
+
+       range->op_flags &= ~OPf_KIDS;
+       range->op_first = Nullop;
+
+       list = (LISTOP*)newLISTOP(OP_LIST, 0, left, right);
+       list->op_first->op_next = range->op_true;
+       left->op_next = range->op_false;
+       right->op_next = (OP*)list;
+       list->op_next = list->op_first;
+
+       op_free(expr);
+       expr = (OP*)(list);
+        null(expr);
+       iterflags |= OPf_STACKED;
+    }
+    else {
+        expr = mod(force_list(expr), OP_GREPSTART);
+    }
+
+
     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
-       append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
-                   scalar(sv))));
+                              append_elem(OP_LIST, expr, scalar(sv))));
     assert(!loop->op_next);
     Renew(loop, 1, LOOP);
     loop->op_targ = padoff;

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index d6d261b..d8323f2 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2047,6 +2047,13 @@ last argument of the previous construct, for example:
 (S) The subroutine being declared or defined had previously been declared
 or defined with a different function prototype.
 
+=item Range iterator outside integer range
+
+(F) One (or both) of the numeric arguments to the range operator ".."
+are outside the range which can be represented by integers internally.
+One possible workaround is to force Perl to use magical string
+increment by prepending "0" to your numbers.
+
 =item Read on closed filehandle E<lt>%sE<gt>
 
 (W) The filehandle you're reading from got itself closed sometime before now.

diff --git a/pod/perlop.pod b/pod/perlop.pod
index 0a081b5..5232278 100644 (file)
--- a/pod/perlop.pod
+++ b/pod/perlop.pod
@@ -369,10 +369,11 @@ Use "or" for assignment is unlikely to do what you want; see below.
 Binary ".." is the range operator, which is really two different
 operators depending on the context.  In list context, it returns an
 array of values counting (by ones) from the left value to the right
-value.  This is useful for writing C<for (1..10)> loops and for doing
-slice operations on arrays.  Be aware that under the current implementation,
-a temporary array is created, so you'll burn a lot of memory if you
-write something like this:
+value.  This is useful for writing C<foreach (1..10)> loops and for
+doing slice operations on arrays.  In the current implementation, no
+temporary array is created when the range operator is used as the
+expression in C<foreach> loops, but older versions of Perl might burn
+a lot of memory when you write something like this:
 
     for (1 .. 1_000_000) {
        # code

diff --git a/pp_ctl.c b/pp_ctl.c
index 1209f7c..5263320 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -815,6 +815,8 @@ PP(pp_flop)
        if (SvNIOKp(left) || !SvPOKp(left) ||
          (looks_like_number(left) && *SvPVX(left) != '0') )
        {
+           if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX)
+               croak("Range iterator outside integer range");
            i = SvIV(left);
            max = SvIV(right);
            if (max >= i) {
@@ -832,14 +834,13 @@ PP(pp_flop)
            char *tmps = SvPV(final, len);
 
            sv = sv_mortalcopy(left);
-           while (!SvNIOKp(sv) && SvCUR(sv) <= len &&
-               strNE(SvPVX(sv),tmps) ) {
+           while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
                XPUSHs(sv);
+               if (strEQ(SvPVX(sv),tmps))
+                   break;
                sv = sv_2mortal(newSVsv(sv));
                sv_inc(sv);
            }
-           if (strEQ(SvPVX(sv),tmps))
-               XPUSHs(sv);
        }
     }
     else {
@@ -1367,8 +1368,22 @@ PP(pp_enteriter)
 
     PUSHBLOCK(cx, CXt_LOOP, SP);
     PUSHLOOP(cx, svp, MARK);
-    if (op->op_flags & OPf_STACKED)
+    if (op->op_flags & OPf_STACKED) {
        cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
+       if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
+           dPOPss;
+           if (SvNIOKp(sv) || !SvPOKp(sv) ||
+               (looks_like_number(sv) && *SvPVX(sv) != '0')) {
+                if (SvNV(sv) < IV_MIN ||
+                    SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
+                    croak("Range iterator outside integer range");
+                cx->blk_loop.iterix = SvIV(sv);
+                cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary);
+           }
+           else
+               cx->blk_loop.iterlval = newSVsv(sv);
+       }
+    }
     else {
        cx->blk_loop.iterary = curstack;
        AvFILLp(curstack) = SP - stack_base;

diff --git a/pp_hot.c b/pp_hot.c
index dd5ef14..8331bb3 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1403,6 +1403,31 @@ PP(pp_iter)
        DIE("panic: pp_iter");
 
     av = cx->blk_loop.iterary;
+    if (SvTYPE(av) != SVt_PVAV) {
+       /* iterate ($min .. $max) */
+       if (cx->blk_loop.iterlval) {
+           /* string increment */
+           register SV* cur = cx->blk_loop.iterlval;
+           STRLEN maxlen;
+           char *max = SvPV((SV*)av, maxlen);
+           if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
+               sv_setsv(*cx->blk_loop.itervar, cur);
+               if (strEQ(SvPVX(cur), max))
+                   sv_setiv(cur, 0); /* terminate next time */
+               else
+                   sv_inc(cur);
+               RETPUSHYES;
+           }
+           RETPUSHNO;
+       }
+       /* integer increment */
+       if (cx->blk_loop.iterix > cx->blk_loop.itermax)
+           RETPUSHNO;
+       sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++);
+       RETPUSHYES;
+    }
+
+    /* iterate array */
     if (cx->blk_loop.iterix >= (av == curstack ? cx->blk_oldsp : AvFILL(av)))
        RETPUSHNO;
 

diff --git a/t/op/range.t b/t/op/range.t
index 746da46..7999b86 100755 (executable)
--- a/t/op/range.t
+++ b/t/op/range.t
@@ -1,8 +1,6 @@
 #!./perl
 
-# $RCSfile: range.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:14 $
-
-print "1..8\n";
+print "1..10\n";
 
 print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n";
 
@@ -34,3 +32,17 @@ print $x eq 'abcdefghijklmnopqrstuvwxyz' ? "ok 7\n" : "not ok 7 $x\n";
 
 @x = 'A'..'ZZ';
 print @x == 27 * 26 ? "ok 8\n" : "not ok 8\n";
+
+@x = '09' .. '08';  # should produce '09', '10',... '99' (strange but true)
+print "not " unless join(",", @x) eq
+                    join(",", map {sprintf "%02d",$_} 9..99);
+print "ok 9\n";
+
+# same test with foreach (which is a separate implementation)
+@y = ();
+foreach ('09'..'08') {
+    push(@y, $_);
+}
+print "not " unless join(",", @y) eq join(",", @x);
+print "ok 10\n";
+