This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
op.c: Add op_folded to BASEOP
authorNiels Thykier <niels@thykier.net>
Wed, 17 Jul 2013 18:59:54 +0000 (20:59 +0200)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 19 Jul 2013 17:11:00 +0000 (10:11 -0700)
Add a new member, op_folded, to BASEOP.  It is replacement for
OPpCONST_FOLDED (which can only be set on OP_CONST).  At the moment
OPpCONST_FOLDED remains, as it is exposed in B (e.g. B::Concise relies
on it).

Signed-off-by: Niels Thykier <niels@thykier.net>
op.c
op.h
toke.c

diff --git a/op.c b/op.c
index d5323a0..a9ee2d1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3345,7 +3345,10 @@ S_fold_constants(pTHX_ OP *o)
     if (type == OP_RV2GV)
        newop = newGVOP(OP_GV, 0, MUTABLE_GV(sv));
     else
+    {
        newop = newSVOP(OP_CONST, OPpCONST_FOLDED<<8, MUTABLE_SV(sv));
+       newop->op_folded = 1;
+    }
     op_getmad(o,newop,'f');
     return newop;
 
@@ -5880,6 +5883,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
                other->op_flags |= OPf_SPECIAL;
            else if (other->op_type == OP_CONST)
                other->op_private |= OPpCONST_FOLDED;
+
+           other->op_folded = 1;
            return other;
        }
        else {
@@ -6041,6 +6046,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
            live->op_flags |= OPf_SPECIAL;
        else if (live->op_type == OP_CONST)
            live->op_private |= OPpCONST_FOLDED;
+       live->op_folded = 1;
        return live;
     }
     NewOp(1101, logop, 1, LOGOP);
@@ -8651,7 +8657,7 @@ Perl_ck_ftst(pTHX_ OP *o)
        const OPCODE kidtype = kid->op_type;
 
        if (kidtype == OP_CONST && (kid->op_private & OPpCONST_BARE)
-        && !(kid->op_private & OPpCONST_FOLDED)) {
+        && !kid->op_folded) {
            OP * const newop = newGVOP(type, OPf_REF,
                gv_fetchsv(kid->op_sv, GV_ADD, SVt_PVIO));
 #ifdef PERL_MAD
@@ -9236,7 +9242,7 @@ Perl_ck_listiob(pTHX_ OP *o)
        kid = kid->op_sibling;
     else if (kid && !kid->op_sibling) {                /* print HANDLE; */
        if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE
-        && !(kid->op_private & OPpCONST_FOLDED)) {
+        && !kid->op_folded) {
            o->op_flags |= OPf_STACKED; /* make it a filehandle */
            kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
            cLISTOPo->op_first->op_sibling = kid;
@@ -10603,8 +10609,8 @@ Perl_ck_trunc(pTHX_ OP *o)
        if (kid->op_type == OP_NULL)
            kid = (SVOP*)kid->op_sibling;
        if (kid && kid->op_type == OP_CONST &&
-           (kid->op_private & (OPpCONST_BARE|OPpCONST_FOLDED))
-                            == OPpCONST_BARE)
+           (kid->op_private & OPpCONST_BARE) &&
+           !kid->op_folded)
        {
            o->op_flags |= OPf_SPECIAL;
            kid->op_private &= ~OPpCONST_STRICT;
diff --git a/op.h b/op.h
index 5d1a771..dcfd5be 100644 (file)
--- a/op.h
+++ b/op.h
@@ -23,7 +23,8 @@
  *     op_static       tell op_free() to skip PerlMemShared_free(), when
  *                      !op_slabbed.
  *     op_savefree     on savestack via SAVEFREEOP
- *     op_spare        Three spare bits
+ *     op_folded       Result/remainder of a constant fold operation.
+ *     op_spare        Two spare bits
  *     op_flags        Flags common to all operations.  See OPf_* below.
  *     op_private      Flags peculiar to a particular operation (BUT,
  *                     by default, set to the number of children until
@@ -56,7 +57,8 @@ typedef PERL_BITFIELD16 Optype;
     PERL_BITFIELD16 op_slabbed:1;      \
     PERL_BITFIELD16 op_savefree:1;     \
     PERL_BITFIELD16 op_static:1;       \
-    PERL_BITFIELD16 op_spare:3;                \
+    PERL_BITFIELD16 op_folded:1;       \
+    PERL_BITFIELD16 op_spare:2;                \
     U8         op_flags;               \
     U8         op_private;
 #endif
@@ -257,6 +259,7 @@ Deprecated.  Use C<GIMME_V> instead.
 #define        OPpCONST_STRICT         8       /* bareword subject to strict 'subs' */
 #define OPpCONST_ENTERED       16      /* Has been entered as symbol. */
 #define OPpCONST_BARE          64      /* Was a bare word (filehandle?). */
+/* Replaced by op_folded in perl itself, still used by B/B::Concise etc. */
 #define OPpCONST_FOLDED                128     /* Result of constant folding */
 
 /* Private for OP_FLIP/FLOP */
diff --git a/toke.c b/toke.c
index a8ce485..2ab2a71 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -7393,6 +7393,7 @@ Perl_yylex(pTHX)
                        SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
                        ((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
                        pl_yylval.opval->op_private = OPpCONST_FOLDED;
+                       pl_yylval.opval->op_folded = 1;
                        pl_yylval.opval->op_flags |= OPf_SPECIAL;
                        TOKEN(WORD);
                    }