From ef3e5ea91ec4f974a02ae36f5bcc9e91bcab852f Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 14 Jul 2004 20:55:30 +0000
Subject: [PATCH] Optimise foreach my $i (reverse ...) foreach without a
 lexical iterator not yet optimised

p4raw-id: //depot/perl@23108
---
 ext/B/B/Concise.pm |  1 +
 op.c               | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 op.h               |  3 +++
 pp_ctl.c           | 13 +++++++++++-
 pp_hot.c           | 38 ++++++++++++++++++++++++++--------
 5 files changed, 106 insertions(+), 10 deletions(-)

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index ebd5848..28545b9 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -546,6 +546,7 @@ $priv{$_}{16} = "TARGMY"
        "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system",
        "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority",
        "setpriority", "time", "sleep");
+$priv{$_}{4} = "REVERSED" for ("enteriter", "iter");
 @{$priv{"const"}}{8,16,32,64,128} = ("STRICT","ENTERED", '$[', "BARE", "WARN");
 $priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM";
 $priv{"list"}{64} = "GUESSED";
diff --git a/op.c b/op.c
index 4f819c3..d4c2887 100644
--- a/op.c
+++ b/op.c
@@ -6717,6 +6717,67 @@ Perl_peep(pTHX_ register OP *o)
 
 	    break;
 	}
+
+	case OP_REVERSE: {
+	    OP *ourmark, *theirmark, *ourlast, *iter;
+	    LISTOP *enter, *exlist;
+	    o->op_opt = 1;
+
+	    enter = (LISTOP *) o->op_next;
+	    if (!enter)
+		break;
+	    if (enter->op_type == OP_NULL) {
+		enter = (LISTOP *) enter->op_next;
+		if (!enter)
+		    break;
+	    }
+	    if (enter->op_type != OP_ENTERITER)
+		break;
+
+	    iter = enter->op_next;
+	    if (!iter || iter->op_type != OP_ITER)
+		break;
+	    
+	    exlist = (LISTOP *) enter->op_last;
+	    if (!exlist || exlist->op_type != OP_NULL
+		|| exlist->op_targ != OP_LIST)
+		break;
+
+	    if (exlist->op_last != o) {
+		/* Mmm. Was expecting to point back to this op.  */
+		break;
+	    }
+	    theirmark = exlist->op_first;
+	    if (!theirmark || theirmark->op_type != OP_PUSHMARK)
+		break;
+
+	    ourmark = ((LISTOP *)o)->op_first;
+	    if (!ourmark || ourmark->op_type != OP_PUSHMARK)
+		break;
+
+	    if (ourmark->op_next != o) {
+		/* There's something between the mark and the reverse, eg
+		   for (1, reverse (...))
+		   so no go.  */
+		break;
+	    }
+
+	    ourlast = ((LISTOP *)o)->op_last;
+	    if (!ourlast || ourlast->op_next != o)
+		break;
+
+	    /* We don't have control over who points to theirmark, so sacrifice
+	       ours.  */
+	    theirmark->op_next = ourmark->op_next;
+	    theirmark->op_flags = ourmark->op_flags;
+	    ourlast->op_next = (OP *) enter;
+	    op_null(ourmark);
+	    op_null(o);
+	    enter->op_private |= OPpITER_REVERSED;
+	    iter->op_private |= OPpITER_REVERSED;
+	    
+	    break;
+	}
 	
 	default:
 	    o->op_opt = 1;
diff --git a/op.h b/op.h
index 6c02a1c..d72c52e 100644
--- a/op.h
+++ b/op.h
@@ -180,6 +180,9 @@ Deprecated.  Use C<GIMME_V> instead.
   /* (lower bits may carry MAXARG) */
 #define OPpTARGET_MY		16	/* Target is PADMY. */
 
+/* Private for OP_ENTERITER and OP_ITER */
+#define OPpITER_REVERSED	4	/* for (reverse ...) */
+
 /* Private for OP_CONST */
 #define	OPpCONST_SHORTCIRCUIT	4	/* eg the constant 5 in (5 || foo) */
 #define	OPpCONST_STRICT		8	/* bearword subject to strict 'subs' */
diff --git a/pp_ctl.c b/pp_ctl.c
index a9bc3e5..1107ad9 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1810,11 +1810,22 @@ PP(pp_enteriter)
 		(void) SvPV(right,n_a);
 	    }
 	}
+	else if (PL_op->op_private & OPpITER_REVERSED) {
+	    cx->blk_loop.itermax = 0;
+	    cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary);
+
+	}
     }
     else {
 	cx->blk_loop.iterary = PL_curstack;
 	AvFILLp(PL_curstack) = SP - PL_stack_base;
-	cx->blk_loop.iterix = MARK - PL_stack_base;
+	if (PL_op->op_private & OPpITER_REVERSED) {
+	    cx->blk_loop.itermax = MARK - PL_stack_base;
+	    cx->blk_loop.iterix = cx->blk_oldsp;
+	}
+	else {
+	    cx->blk_loop.iterix = MARK - PL_stack_base;
+	}
     }
 
     RETURN;
diff --git a/pp_hot.c b/pp_hot.c
index 382030d..4157736 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1886,19 +1886,39 @@ PP(pp_iter)
     }
 
     /* iterate array */
-    if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av)))
-	RETPUSHNO;
+    if (PL_op->op_private & OPpITER_REVERSED) {
+	/* In reverse, use itermax as the min :-)  */
+	if (cx->blk_loop.iterix <= 0)
+	    RETPUSHNO;
 
-    if (SvMAGICAL(av) || AvREIFY(av)) {
-	SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
-	if (svp)
-	    sv = *svp;
-	else
-	    sv = Nullsv;
+	if (SvMAGICAL(av) || AvREIFY(av)) {
+	    SV **svp = av_fetch(av, cx->blk_loop.iterix--, FALSE);
+	    if (svp)
+		sv = *svp;
+	    else
+		sv = Nullsv;
+	}
+	else {
+	    sv = AvARRAY(av)[cx->blk_loop.iterix--];
+	}
     }
     else {
-	sv = AvARRAY(av)[++cx->blk_loop.iterix];
+	if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp :
+				    AvFILL(av)))
+	    RETPUSHNO;
+
+	if (SvMAGICAL(av) || AvREIFY(av)) {
+	    SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
+	    if (svp)
+		sv = *svp;
+	    else
+		sv = Nullsv;
+	}
+	else {
+	    sv = AvARRAY(av)[++cx->blk_loop.iterix];
+	}
     }
+
     if (sv && SvREFCNT(sv) == 0) {
 	*itersvp = Nullsv;
 	Perl_croak(aTHX_ "Use of freed value in iteration");
-- 
2.7.4