summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ext/B/B/Concise.pm1
-rw-r--r--op.c61
-rw-r--r--op.h3
-rw-r--r--pp_ctl.c13
-rw-r--r--pp_hot.c38
5 files changed, 106 insertions, 10 deletions
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index ebd5848e60..28545b98ed 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 4f819c3d08..d4c28874a7 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 6c02a1c5f8..d72c52e77c 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 a9bc3e5e09..1107ad9461 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 382030db0d..4157736753 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");