diff options
| -rw-r--r-- | cop.h | 48 | ||||
| -rw-r--r-- | lib/B/Op_private.pm | 4 | ||||
| -rw-r--r-- | opcode.h | 6 | ||||
| -rw-r--r-- | perl.h | 5 | ||||
| -rw-r--r-- | pp_ctl.c | 79 | ||||
| -rw-r--r-- | pp_hot.c | 57 | ||||
| -rw-r--r-- | regen/op_private | 5 | ||||
| -rw-r--r-- | scope.c | 5 | ||||
| -rw-r--r-- | sv.c | 3 |
9 files changed, 110 insertions, 102 deletions
@@ -770,15 +770,19 @@ struct block_loop { } itervar_u; SV *itersave; /* the original iteration var */ union { - struct { /* valid if type is LOOP_FOR or LOOP_PLAIN (but {NULL,0})*/ - AV * ary; /* use the stack if this is NULL */ - IV ix; + struct { /* CXt_LOOP_ARY, C<for (@ary)> */ + AV *ary; /* array being iterated over */ + IV ix; /* index relative to base of array */ } ary; - struct { /* valid if type is LOOP_LAZYIV */ + struct { /* CXt_LOOP_LIST, C<for (list)> */ + I32 basesp; /* first element of list on stack */ + IV ix; /* index relative to basesp */ + } stack; + struct { /* CXt_LOOP_LAZYIV, C<for (1..9)> */ IV cur; IV end; } lazyiv; - struct { /* valid if type if LOOP_LAZYSV */ + struct { /* CXt_LOOP_LAZYSV C<for ('a'..'z')> */ SV * cur; SV * end; /* maxiumum value (or minimum in reverse) */ } lazysv; @@ -822,8 +826,6 @@ struct block_loop { #define PUSHLOOP_FOR(cx, ivar, isave, 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->cx_old_savestack_ix = PL_savestack_ix; \ cx->blk_loop.itersave = isave; \ @@ -834,7 +836,7 @@ struct block_loop { SvREFCNT_dec_NN(cx->blk_loop.state_u.lazysv.cur); \ SvREFCNT_dec_NN(cx->blk_loop.state_u.lazysv.end); \ } \ - else if (CxTYPE(cx) == CXt_LOOP_FOR) \ + else if (CxTYPE(cx) == CXt_LOOP_ARY) \ SvREFCNT_dec(cx->blk_loop.state_u.ary.ary); \ if (cx->cx_type & (CXp_FOR_PAD|CXp_FOR_GV)) { \ SV *cursv; \ @@ -1035,15 +1037,19 @@ struct context { The first 4 don't have a 'case' in at least one switch statement in pp_ctl.c */ #define CXt_GIVEN 3 -/* This is first so that CXt_LOOP_FOR|CXt_LOOP_LAZYIV is CXt_LOOP_LAZYIV */ -#define CXt_LOOP_FOR 4 -#define CXt_LOOP_PLAIN 5 -#define CXt_LOOP_LAZYSV 6 -#define CXt_LOOP_LAZYIV 7 -#define CXt_SUB 8 -#define CXt_FORMAT 9 -#define CXt_EVAL 10 -#define CXt_SUBST 11 + +/* be careful of the ordering of these five. Macros like CxTYPE_is_LOOP, + * CxFOREACH compare ranges */ +#define CXt_LOOP_PLAIN 4 /* {} */ +#define CXt_LOOP_LAZYIV 5 /* for (1..9) {} */ +#define CXt_LOOP_LAZYSV 6 /* for ('a'..'z') {} */ +#define CXt_LOOP_LIST 7 /* for (1,2,3) {} */ +#define CXt_LOOP_ARY 8 /* for (@ary) {} */ + +#define CXt_SUB 9 +#define CXt_FORMAT 10 +#define CXt_EVAL 11 +#define CXt_SUBST 12 /* SUBST doesn't feature in all switch statements. */ /* private flags for CXt_SUB and CXt_FORMAT */ @@ -1068,15 +1074,15 @@ struct context { #define CXp_ONCE 0x10 /* What was sbu_once in struct subst */ #define CxTYPE(c) ((c)->cx_type & CXTYPEMASK) -#define CxTYPE_is_LOOP(c) (((c)->cx_type & 0xC) == 0x4) +#define CxTYPE_is_LOOP(c) ( CxTYPE(cx) >= CXt_LOOP_PLAIN \ + && CxTYPE(cx) <= CXt_LOOP_ARY) #define CxMULTICALL(c) ((c)->cx_type & CXp_MULTICALL) #define CxREALEVAL(c) (((c)->cx_type & (CXTYPEMASK|CXp_REAL)) \ == (CXt_EVAL|CXp_REAL)) #define CxTRYBLOCK(c) (((c)->cx_type & (CXTYPEMASK|CXp_TRYBLOCK)) \ == (CXt_EVAL|CXp_TRYBLOCK)) -#define CxFOREACH(c) (CxTYPE_is_LOOP(c) && CxTYPE(c) != CXt_LOOP_PLAIN) -#define CxFOREACHDEF(c) ((CxTYPE_is_LOOP(c) && CxTYPE(c) != CXt_LOOP_PLAIN) \ - && ((c)->cx_type & CXp_FOR_DEF)) +#define CxFOREACH(c) ( CxTYPE(cx) >= CXt_LOOP_LAZYSV \ + && CxTYPE(cx) <= CXt_LOOP_ARY) #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc())) diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 85076ee251..7825f79f3d 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -130,7 +130,7 @@ $bits{$_}{2} = 'OPpFT_STACKED' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir $bits{$_}{3} = 'OPpFT_STACKING' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero); $bits{$_}{1} = 'OPpHINT_STRICT_REFS' for qw(entersub multideref rv2av rv2cv rv2gv rv2hv rv2sv); $bits{$_}{5} = 'OPpHUSH_VMSISH' for qw(dbstate nextstate); -$bits{$_}{2} = 'OPpITER_REVERSED' for qw(enteriter iter); +$bits{$_}{1} = 'OPpITER_REVERSED' for qw(enteriter iter); $bits{$_}{7} = 'OPpLVALUE' for qw(leave leaveloop); $bits{$_}{6} = 'OPpLVAL_DEFER' for qw(aelem helem multideref); $bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv); @@ -604,7 +604,7 @@ our %defines = ( OPpHINT_STRICT_REFS => 2, OPpHUSH_VMSISH => 32, OPpITER_DEF => 8, - OPpITER_REVERSED => 4, + OPpITER_REVERSED => 2, OPpLIST_GUESSED => 64, OPpLVALUE => 128, OPpLVAL_DEFER => 64, @@ -2190,6 +2190,7 @@ END_EXTERN_C #define OPpEVAL_HAS_HH 0x02 #define OPpFT_ACCESS 0x02 #define OPpHINT_STRICT_REFS 0x02 +#define OPpITER_REVERSED 0x02 #define OPpSORT_INTEGER 0x02 #define OPpTRANS_TO_UTF 0x02 #define OPpARG2_MASK 0x03 @@ -2198,7 +2199,6 @@ END_EXTERN_C #define OPpENTERSUB_HASTARG 0x04 #define OPpEVAL_UNICODE 0x04 #define OPpFT_STACKED 0x04 -#define OPpITER_REVERSED 0x04 #define OPpLVREF_ELEM 0x04 #define OPpSLICEWARNING 0x04 #define OPpSORT_REVERSE 0x04 @@ -2873,8 +2873,8 @@ EXTCONST U16 PL_op_private_bitdefs[] = { 0x00bc, 0x012f, /* caller */ 0x21f5, /* nextstate, dbstate */ 0x29fc, 0x33d9, /* leave */ - 0x2b5c, 0x3078, 0x0e8c, 0x36e9, /* enteriter */ - 0x36e9, /* iter */ + 0x2b5c, 0x3078, 0x0e8c, 0x36e5, /* enteriter */ + 0x36e5, /* iter */ 0x29fc, 0x0067, /* leaveloop */ 0x41dc, 0x0003, /* last, next, redo, dump, goto */ 0x325c, 0x3178, 0x2634, 0x2570, 0x012f, /* open */ @@ -5110,10 +5110,11 @@ EXTCONST char* const PL_block_type[] = { "WHEN", "BLOCK", "GIVEN", - "LOOP_FOR", "LOOP_PLAIN", - "LOOP_LAZYSV", "LOOP_LAZYIV", + "LOOP_LAZYSV", + "LOOP_LIST", + "LOOP_ARY", "SUB", "FORMAT", "EVAL", @@ -1266,10 +1266,11 @@ static const char * const context_name[] = { NULL, /* CXt_WHEN never actually needs "block" */ NULL, /* CXt_BLOCK never actually needs "block" */ NULL, /* CXt_GIVEN never actually needs "block" */ - NULL, /* CXt_LOOP_FOR never actually needs "loop" */ NULL, /* CXt_LOOP_PLAIN never actually needs "loop" */ - NULL, /* CXt_LOOP_LAZYSV never actually needs "loop" */ NULL, /* CXt_LOOP_LAZYIV never actually needs "loop" */ + NULL, /* CXt_LOOP_LAZYSV never actually needs "loop" */ + NULL, /* CXt_LOOP_LIST never actually needs "loop" */ + NULL, /* CXt_LOOP_ARY never actually needs "loop" */ "subroutine", "format", "eval", @@ -1297,10 +1298,11 @@ S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags) if (CxTYPE(cx) == CXt_NULL) /* sort BLOCK */ return -1; break; + case CXt_LOOP_PLAIN: case CXt_LOOP_LAZYIV: case CXt_LOOP_LAZYSV: - case CXt_LOOP_FOR: - case CXt_LOOP_PLAIN: + case CXt_LOOP_LIST: + case CXt_LOOP_ARY: { STRLEN cx_label_len = 0; U32 cx_label_flags = 0; @@ -1444,10 +1446,11 @@ S_dopoptoloop(pTHX_ I32 startingblock) if ((CxTYPE(cx)) == CXt_NULL) /* sort BLOCK */ return -1; break; + case CXt_LOOP_PLAIN: case CXt_LOOP_LAZYIV: case CXt_LOOP_LAZYSV: - case CXt_LOOP_FOR: - case CXt_LOOP_PLAIN: + case CXt_LOOP_LIST: + case CXt_LOOP_ARY: DEBUG_l( Perl_deb(aTHX_ "(dopoptoloop(): found loop at cx=%ld)\n", (long)i)); return i; } @@ -1470,12 +1473,13 @@ S_dopoptogivenfor(pTHX_ I32 startingblock) DEBUG_l( Perl_deb(aTHX_ "(dopoptogivenfor(): found given at cx=%ld)\n", (long)i)); return i; case CXt_LOOP_PLAIN: - assert(!CxFOREACHDEF(cx)); + assert(!(cx->cx_type & CXp_FOR_DEF)); break; case CXt_LOOP_LAZYIV: case CXt_LOOP_LAZYSV: - case CXt_LOOP_FOR: - if (CxFOREACHDEF(cx)) { + case CXt_LOOP_LIST: + case CXt_LOOP_ARY: + if (cx->cx_type & CXp_FOR_DEF) { DEBUG_l( Perl_deb(aTHX_ "(dopoptogivenfor(): found foreach at cx=%ld)\n", (long)i)); return i; } @@ -1527,10 +1531,11 @@ Perl_dounwind(pTHX_ I32 cxix) case CXt_BLOCK: POPBASICBLK(cx); break; + case CXt_LOOP_PLAIN: case CXt_LOOP_LAZYIV: case CXt_LOOP_LAZYSV: - case CXt_LOOP_FOR: - case CXt_LOOP_PLAIN: + case CXt_LOOP_LIST: + case CXt_LOOP_ARY: POPLOOP(cx); break; case CXt_WHEN: @@ -2142,7 +2147,7 @@ PP(pp_enteriter) const I32 gimme = GIMME_V; void *itervarp; /* GV or pad slot of the iteration variable */ SV *itersave; /* the old var in the iterator var slot */ - U8 cxtype = CXt_LOOP_FOR; + U8 cxflags = 0; if (PL_op->op_targ) { /* "my" variable */ itervarp = &PAD_SVl(PL_op->op_targ); @@ -2155,7 +2160,7 @@ PP(pp_enteriter) SvPADSTALE_on(itersave); } SvREFCNT_inc_simple_void_NN(itersave); - cxtype |= CXp_FOR_PAD; + cxflags = CXp_FOR_PAD; } else { SV * const sv = POPs; @@ -2167,37 +2172,33 @@ PP(pp_enteriter) SvREFCNT_inc_simple_void_NN(itersave); else *svp = newSV(0); - cxtype |= CXp_FOR_GV; + cxflags = CXp_FOR_GV; } else { /* LV ref: for \$foo (...) */ assert(SvTYPE(sv) == SVt_PVMG); assert(SvMAGIC(sv)); assert(SvMAGIC(sv)->mg_type == PERL_MAGIC_lvref); itersave = NULL; - cxtype |= CXp_FOR_LVREF; + cxflags = CXp_FOR_LVREF; } } if (PL_op->op_private & OPpITER_DEF) - cxtype |= CXp_FOR_DEF; + cxflags |= CXp_FOR_DEF; - PUSHBLOCK(cx, cxtype, SP); + PUSHBLOCK(cx, cxflags, SP); PUSHLOOP_FOR(cx, itervarp, itersave, MARK); if (PL_op->op_flags & OPf_STACKED) { SV *maybe_ary = POPs; if (SvTYPE(maybe_ary) != SVt_PVAV) { dPOPss; SV * const right = maybe_ary; - if (UNLIKELY(cxtype & CXp_FOR_LVREF)) + if (UNLIKELY(cxflags & CXp_FOR_LVREF)) DIE(aTHX_ "Assigned value is not a reference"); SvGETMAGIC(sv); SvGETMAGIC(right); if (RANGE_IS_NUMERIC(sv,right)) { - cx->cx_type &= ~CXTYPEMASK; cx->cx_type |= CXt_LOOP_LAZYIV; - /* Make sure that no-one re-orders cop.h and breaks our - assumptions */ - assert(CxTYPE(cx) == CXt_LOOP_LAZYIV); if (S_outside_integer(aTHX_ sv) || S_outside_integer(aTHX_ right)) DIE(aTHX_ "Range iterator outside integer range"); @@ -2209,11 +2210,7 @@ PP(pp_enteriter) #endif } else { - cx->cx_type &= ~CXTYPEMASK; cx->cx_type |= CXt_LOOP_LAZYSV; - /* Make sure that no-one re-orders cop.h and breaks our - assumptions */ - assert(CxTYPE(cx) == CXt_LOOP_LAZYSV); cx->blk_loop.state_u.lazysv.cur = newSVsv(sv); cx->blk_loop.state_u.lazysv.end = right; SvREFCNT_inc(right); @@ -2230,6 +2227,7 @@ PP(pp_enteriter) } } else /* SvTYPE(maybe_ary) == SVt_PVAV */ { + cx->cx_type |= CXt_LOOP_ARY; cx->blk_loop.state_u.ary.ary = MUTABLE_AV(maybe_ary); SvREFCNT_inc(maybe_ary); cx->blk_loop.state_u.ary.ix = @@ -2239,13 +2237,12 @@ PP(pp_enteriter) } } else { /* iterating over items on the stack */ - cx->blk_loop.state_u.ary.ary = NULL; /* means to use the stack */ - if (PL_op->op_private & OPpITER_REVERSED) { - cx->blk_loop.state_u.ary.ix = cx->blk_oldsp + 1; - } - else { - cx->blk_loop.state_u.ary.ix = MARK - PL_stack_base; - } + cx->cx_type |= CXt_LOOP_LIST; + cx->blk_loop.state_u.stack.basesp = MARK - PL_stack_base; + cx->blk_loop.state_u.stack.ix = + (PL_op->op_private & OPpITER_REVERSED) + ? cx->blk_oldsp + 1 + : cx->blk_loop.state_u.stack.basesp; } RETURN; @@ -2577,12 +2574,7 @@ PP(pp_last) cx = &cxstack[cxstack_ix]; - assert( - CxTYPE(cx) == CXt_LOOP_LAZYIV - || CxTYPE(cx) == CXt_LOOP_LAZYSV - || CxTYPE(cx) == CXt_LOOP_FOR - || CxTYPE(cx) == CXt_LOOP_PLAIN - ); + assert(CxTYPE_is_LOOP(cx)); PL_stack_sp = PL_stack_base + cx->blk_loop.resetsp; TAINT_NOT; @@ -2969,10 +2961,11 @@ PP(pp_goto) break; } /* else fall through */ - case CXt_LOOP_LAZYIV: - case CXt_LOOP_LAZYSV: - case CXt_LOOP_FOR: - case CXt_LOOP_PLAIN: + case CXt_LOOP_PLAIN: + case CXt_LOOP_LAZYIV: + case CXt_LOOP_LAZYSV: + case CXt_LOOP_LIST: + case CXt_LOOP_ARY: case CXt_GIVEN: case CXt_WHEN: gotoprobe = OpSIBLING(cx->blk_oldcop); @@ -247,13 +247,7 @@ PP(pp_unstack) PL_stack_sp = PL_stack_base + cx->blk_oldsp; FREETMPS; if (!(PL_op->op_flags & OPf_SPECIAL)) { - assert( - CxTYPE(cx) == CXt_BLOCK - || CxTYPE(cx) == CXt_LOOP_FOR - || CxTYPE(cx) == CXt_LOOP_PLAIN - || CxTYPE(cx) == CXt_LOOP_LAZYSV - || CxTYPE(cx) == CXt_LOOP_LAZYIV - ); + assert(CxTYPE(cx) == CXt_BLOCK || CxTYPE_is_LOOP(cx)); CX_LEAVE_SCOPE(cx); } return NORMAL; @@ -2702,28 +2696,37 @@ PP(pp_iter) break; } - case CXt_LOOP_FOR: /* iterate array */ { - - AV *av = cx->blk_loop.state_u.ary.ary; SV *sv; - bool av_is_stack = FALSE; + AV *av; IV ix; + IV inc; - if (!av) { - av_is_stack = TRUE; - av = PL_curstack; - } - if (PL_op->op_private & OPpITER_REVERSED) { - ix = --cx->blk_loop.state_u.ary.ix; - if (UNLIKELY(ix <= (av_is_stack ? cx->blk_loop.resetsp : -1))) - RETPUSHNO; - } - else { - ix = ++cx->blk_loop.state_u.ary.ix; - if (UNLIKELY(ix > (av_is_stack ? cx->blk_oldsp : AvFILL(av)))) - RETPUSHNO; - } + case CXt_LOOP_LIST: /* for (1,2,3) */ + + assert(OPpITER_REVERSED == 2); /* so inc becomes -1 or 1 */ + inc = 1 - (PL_op->op_private & OPpITER_REVERSED); + ix = (cx->blk_loop.state_u.stack.ix += inc); + if (UNLIKELY(inc > 0 + ? ix > cx->blk_oldsp + : ix <= cx->blk_loop.state_u.stack.basesp) + ) + RETPUSHNO; + + sv = PL_stack_base[ix]; + av = NULL; + goto loop_ary_common; + + case CXt_LOOP_ARY: /* for (@ary) */ + + av = cx->blk_loop.state_u.ary.ary; + inc = 1 - (PL_op->op_private & OPpITER_REVERSED); + ix = (cx->blk_loop.state_u.ary.ix += inc); + if (UNLIKELY(inc > 0 + ? ix > AvFILL(av) + : ix < 0) + ) + RETPUSHNO; if (UNLIKELY(SvMAGICAL(av) || AvREIFY(av))) { SV * const * const svp = av_fetch(av, ix, FALSE); @@ -2733,6 +2736,8 @@ PP(pp_iter) sv = AvARRAY(av)[ix]; } + loop_ary_common: + if (UNLIKELY(cx->cx_type & CXp_FOR_LVREF)) { SvSetMagicSV(*itersvp, sv); break; @@ -2751,7 +2756,7 @@ PP(pp_iter) SvREFCNT_inc_simple_void_NN(sv); } } - else if (!av_is_stack) { + else if (av) { sv = newSVavdefelem(av, ix, 0); } else diff --git a/regen/op_private b/regen/op_private index ab63e11833..a7f569e38e 100644 --- a/regen/op_private +++ b/regen/op_private @@ -619,12 +619,13 @@ addbits('rv2gv', ); +# NB OPpITER_REVERSED must always be bit 1: see pp_iter() addbits('enteriter', - 2 => qw(OPpITER_REVERSED REVERSED),# for (reverse ...) + 1 => qw(OPpITER_REVERSED REVERSED),# for (reverse ...) 3 => qw(OPpITER_DEF DEF), # 'for $_' ); -addbits('iter', 2 => qw(OPpITER_REVERSED REVERSED)); +addbits('iter', 1 => qw(OPpITER_REVERSED REVERSED)); @@ -1366,10 +1366,11 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) PTR2UV(cx->blk_eval.retop)); break; + case CXt_LOOP_PLAIN: case CXt_LOOP_LAZYIV: case CXt_LOOP_LAZYSV: - case CXt_LOOP_FOR: - case CXt_LOOP_PLAIN: + case CXt_LOOP_LIST: + case CXt_LOOP_ARY: PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx)); PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n", (long)cx->blk_loop.resetsp); @@ -13969,10 +13969,11 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param) assert ((void *) &ncx->blk_loop.state_u.ary.ary == (void *) &ncx->blk_loop.state_u.lazysv.cur); /* FALLTHROUGH */ - case CXt_LOOP_FOR: + case CXt_LOOP_ARY: ncx->blk_loop.state_u.ary.ary = av_dup_inc(ncx->blk_loop.state_u.ary.ary, param); /* FALLTHROUGH */ + case CXt_LOOP_LIST: case CXt_LOOP_LAZYIV: case CXt_LOOP_PLAIN: /* code common to all CXt_LOOP_* types */ |