use LOOP struct for entergiven op
authorZefram <zefram@fysh.org>
Wed, 29 Nov 2017 00:13:38 +0000 (00:13 +0000)
committerZefram <zefram@fysh.org>
Wed, 29 Nov 2017 00:13:38 +0000 (00:13 +0000)
This will support the upcoming change to let loop control ops apply to
"given" blocks.

dump.c
embed.fnc
embed.h
inline.h
lib/B/Op_private.pm
op.c
opcode.h
proto.h
regen/opcodes

diff --git a/dump.c b/dump.c
index b2f0fc5..009266c 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -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:
index 8e05b6c..dc4e6fc 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -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
diff --git a/embed.h b/embed.h
index f726f97..e0362ef 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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)
index 2f67af8..2b0a23d 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -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;
 }
 
index 37497af..e059278 100644 (file)
@@ -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];
diff --git a/op.c b/op.c
index cc9b666..f75c933 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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)
index e1ba36b..06b75cd 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -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),
diff --git a/proto.h b/proto.h
index 50f935d..fd0f145 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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
index 18dc4fc..b60eda0 100644 (file)
@@ -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