diff options
| -rw-r--r-- | dump.c | 2 | ||||
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | inline.h | 2 | ||||
| -rw-r--r-- | lib/B/Op_private.pm | 1 | ||||
| -rw-r--r-- | op.c | 79 | ||||
| -rw-r--r-- | opcode.h | 8 | ||||
| -rw-r--r-- | proto.h | 3 | ||||
| -rw-r--r-- | regen/opcodes | 2 |
9 files changed, 44 insertions, 56 deletions
@@ -1200,6 +1200,7 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) case OP_ENTERITER: case OP_ENTERLOOP: + case OP_ENTERGIVEN: S_opdump_indent(aTHX_ o, level, bar, file, "REDO"); S_opdump_link(aTHX_ cLOOPo->op_redoop, file); S_opdump_indent(aTHX_ o, level, bar, file, "NEXT"); @@ -1221,7 +1222,6 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) case OP_DORASSIGN: case OP_ANDASSIGN: case OP_ARGDEFELEM: - case OP_ENTERGIVEN: case OP_ENTERWHEN: case OP_ENTERTRY: case OP_ONCE: @@ -2140,8 +2140,6 @@ s |void |no_bareword_allowed|NN OP *o sR |OP* |no_fh_allowed|NN OP *o sR |OP* |too_few_arguments_pv|NN OP *o|NN const char* name|U32 flags s |OP* |too_many_arguments_pv|NN OP *o|NN const char* name|U32 flags -s |OP* |newGIVWHENOP |NULLOK OP* cond|NN OP *block \ - |I32 enter_opcode|I32 leave_opcode s |bool |process_special_blocks |I32 floor \ |NN const char *const fullname\ |NN GV *const gv|NN CV *const cv @@ -1654,7 +1654,6 @@ #define modkids(a,b) S_modkids(aTHX_ a,b) #define move_proto_attr(a,b,c,d) S_move_proto_attr(aTHX_ a,b,c,d) #define my_kid(a,b,c) S_my_kid(aTHX_ a,b,c) -#define newGIVWHENOP(a,b,c,d) S_newGIVWHENOP(aTHX_ a,b,c,d) #define newMETHOP_internal(a,b,c,d) S_newMETHOP_internal(aTHX_ a,b,c,d) #define new_logop(a,b,c,d) S_new_logop(aTHX_ a,b,c,d) #define no_bareword_allowed(a) S_no_bareword_allowed(aTHX_ a) @@ -1657,7 +1657,7 @@ S_cx_pushgiven(pTHX_ PERL_CONTEXT *cx, SV *orig_defsv) { PERL_ARGS_ASSERT_CX_PUSHGIVEN; - cx->blk_givwhen.leave_op = cLOGOP->op_other; + cx->blk_givwhen.leave_op = cLOOP->op_lastop; cx->blk_givwhen.defsv_save = orig_defsv; } diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 37497af523..e05927866a 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -304,7 +304,6 @@ $bits{dorassign}{0} = $bf[0]; $bits{dump}{0} = $bf[0]; $bits{each}{0} = $bf[0]; @{$bits{entereval}}{5,4,3,2,1,0} = ('OPpEVAL_RE_REPARSING', 'OPpEVAL_COPHH', 'OPpEVAL_BYTES', 'OPpEVAL_UNICODE', 'OPpEVAL_HAS_HH', $bf[0]); -$bits{entergiven}{0} = $bf[0]; $bits{enteriter}{3} = 'OPpITER_DEF'; @{$bits{entersub}}{5,4,0} = ($bf[8], $bf[8], 'OPpENTERSUB_INARGS'); $bits{entertry}{0} = $bf[0]; @@ -8766,45 +8766,6 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label) return o; } -/* These construct the optree fragments representing given() - and when() blocks. - - entergiven and enterwhen are LOGOPs; the op_other pointer - points up to the associated leave op. We need this so we - can put it in the context and make break/continue work. - (Also, of course, pp_enterwhen will jump straight to - op_other if the match fails.) - */ - -STATIC OP * -S_newGIVWHENOP(pTHX_ OP *cond, OP *block, I32 enter_opcode, I32 leave_opcode) -{ - dVAR; - LOGOP *enterop; - OP *o; - - PERL_ARGS_ASSERT_NEWGIVWHENOP; - - enterop = alloc_LOGOP(enter_opcode, block, NULL); - enterop->op_targ = 0; - enterop->op_private = 0; - - o = newUNOP(leave_opcode, 0, (OP *) enterop); - - op_sibling_splice((OP*)enterop, NULL, 0, scalar(cond)); - o->op_next = LINKLIST(cond); - cond->op_next = (OP *) enterop; - - CHECKOP(enter_opcode, enterop); /* Currently does nothing, since - entergiven and enterwhen both - use ck_null() */ - - enterop->op_next = LINKLIST(block); - block->op_next = enterop->op_other = o; - - return o; -} - /* =for apidoc Am|OP *|newGIVENOP|OP *cond|OP *block|PADOFFSET defsv_off @@ -8820,11 +8781,28 @@ C<defsv_off> must be zero (it used to identity the pad slot of lexical $_). OP * Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off) { + OP *enterop, *leaveop; PERL_ARGS_ASSERT_NEWGIVENOP; PERL_UNUSED_ARG(defsv_off); - assert(!defsv_off); - return newGIVWHENOP(cond, block, OP_ENTERGIVEN, OP_LEAVEGIVEN); + + NewOpSz(1101, enterop, sizeof(LOOP)); + OpTYPE_set(enterop, OP_ENTERGIVEN); + cLOOPx(enterop)->op_first = scalar(cond); + cLOOPx(enterop)->op_last = block; + OpMORESIB_set(cond, block); + OpLASTSIB_set(block, enterop); + enterop->op_flags = OPf_KIDS; + + leaveop = newUNOP(OP_LEAVEGIVEN, 0, enterop); + leaveop->op_next = LINKLIST(cond); + cond->op_next = enterop; + enterop = CHECKOP(OP_ENTERGIVEN, enterop); + cLOOPx(enterop)->op_redoop = enterop->op_next = LINKLIST(block); + cLOOPx(enterop)->op_lastop = cLOOPx(enterop)->op_nextop = block->op_next = + leaveop; + + return leaveop; } /* @@ -8841,8 +8819,24 @@ by this function and become part of the constructed op tree. OP * Perl_newWHENOP(pTHX_ OP *cond, OP *block) { + OP *enterop, *leaveop; PERL_ARGS_ASSERT_NEWWHENOP; - return newGIVWHENOP(cond, block, OP_ENTERWHEN, OP_LEAVEWHEN); + + NewOpSz(1101, enterop, sizeof(LOGOP)); + OpTYPE_set(enterop, OP_ENTERWHEN); + cLOGOPx(enterop)->op_first = scalar(cond); + OpMORESIB_set(cond, block); + OpLASTSIB_set(block, enterop); + enterop->op_flags = OPf_KIDS; + + leaveop = newUNOP(OP_LEAVEWHEN, 0, enterop); + leaveop->op_next = LINKLIST(cond); + cond->op_next = enterop; + enterop = CHECKOP(OP_ENTERWHEN, enterop); + enterop->op_next = LINKLIST(block); + cLOGOPx(enterop)->op_other = block->op_next = leaveop; + + return leaveop; } /* must not conflict with SVf_UTF8 */ @@ -15527,6 +15521,7 @@ Perl_rpeep(pTHX_ OP *o) case OP_ENTERLOOP: case OP_ENTERITER: + case OP_ENTERGIVEN: while (cLOOP->op_redoop->op_type == OP_NULL) cLOOP->op_redoop = cLOOP->op_redoop->op_next; while (cLOOP->op_nextop->op_type == OP_NULL) @@ -2007,7 +2007,7 @@ EXTCONST U32 PL_opargs[] = { 0x00000e40, /* method_super */ 0x00000e40, /* method_redir */ 0x00000e40, /* method_redir_super */ - 0x00000340, /* entergiven */ + 0x00000940, /* entergiven */ 0x00000100, /* leavegiven */ 0x00000340, /* enterwhen */ 0x00000100, /* leavewhen */ @@ -2673,7 +2673,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* method_super */ 0, /* method_redir */ 0, /* method_redir_super */ - 0, /* entergiven */ + -1, /* entergiven */ 0, /* leavegiven */ 0, /* enterwhen */ 0, /* leavewhen */ @@ -2871,7 +2871,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { */ EXTCONST U16 PL_op_private_bitdefs[] = { - 0x0003, /* scalar, prototype, refgen, srefgen, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, pop, shift, grepstart, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, argcheck, argdefelem, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */ + 0x0003, /* scalar, prototype, refgen, srefgen, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, pop, shift, grepstart, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, argcheck, argdefelem, method, method_named, method_super, method_redir, method_redir_super, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */ 0x2f3c, 0x4039, /* pushmark */ 0x00bd, /* wantarray, runcv */ 0x0578, 0x19b0, 0x40ec, 0x3ba8, 0x3385, /* const */ @@ -3165,7 +3165,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* METHOD_SUPER */ (OPpARG1_MASK), /* METHOD_REDIR */ (OPpARG1_MASK), /* METHOD_REDIR_SUPER */ (OPpARG1_MASK), - /* ENTERGIVEN */ (OPpARG1_MASK), + /* ENTERGIVEN */ (0), /* LEAVEGIVEN */ (OPpARG1_MASK), /* ENTERWHEN */ (OPpARG1_MASK), /* LEAVEWHEN */ (OPpARG1_MASK), @@ -4739,9 +4739,6 @@ STATIC void S_move_proto_attr(pTHX_ OP **proto, OP **attrs, const GV *name, bool STATIC OP * S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp); #define PERL_ARGS_ASSERT_MY_KID \ assert(imopsp) -STATIC OP* S_newGIVWHENOP(pTHX_ OP* cond, OP *block, I32 enter_opcode, I32 leave_opcode); -#define PERL_ARGS_ASSERT_NEWGIVWHENOP \ - assert(block) #ifndef PERL_NO_INLINE_FUNCTIONS PERL_STATIC_INLINE OP* S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth); #endif diff --git a/regen/opcodes b/regen/opcodes index 18dc4fcbfa..b60eda097b 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -328,7 +328,7 @@ method_super super with known name ck_null d. method_redir redirect method with known name ck_null d. method_redir_super redirect super method with known name ck_null d. -entergiven given() ck_null d| +entergiven given() ck_null d{ leavegiven leave given block ck_null 1 enterwhen when() ck_null d| leavewhen leave when block ck_null 1 |