Optimise __SUB__ to a constant
authorFather Chrysostomos <sprout@cpan.org>
Fri, 25 Nov 2011 21:36:29 +0000 (13:36 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 26 Nov 2011 22:33:46 +0000 (14:33 -0800)
If __SUB__ is not inside a closure, it can be optimised to a constant.
We can only do this in the peephole optimiser, as we cannot tell
whether PL_compcv will become a closure until we reach the end
of the sub.

The __SUB__ op cannot simply be replaced with a const op, as the par-
ent op is not readily available in the peephole optimiser and, hence,
we cannot change its pointer.

So we have to convert the runcv op itself into a const op.  So it
has to be the same size.  This commit makes it a PVOP, since newPVOP,
unlike newSVOP, allows a null pv.  To avoid adding workarounds to B
modules, I put an exception in newPVOP’s assertion, instead of chang-
ing the type in regen/opcodes.

But B::Deparse still had to be updated to avoid infinite recursion.

dist/B-Deparse/Deparse.pm
op.c
toke.c

index 933e19a..b9381a6 100644 (file)
@@ -3809,6 +3809,18 @@ sub const {
            }
            return "{" . join(", ", @elts) . "}";
        } elsif (class($ref) eq "CV") {
+           BEGIN {
+# Commented out until after 5.15.6
+#              if ($] > 5.0150051) {
+                   require overloading;
+                   unimport overloading;
+#              }
+           }
+           # Remove the 1|| after 5.15.6
+           if ((1||$] > 5.0150051) && $self->{curcv} &&
+                $self->{curcv}->object_2svref == $ref->object_2svref) {
+               return $self->keyword("__SUB__");
+           }
            return "sub " . $self->deparse_sub($ref);
        }
        if ($ref->FLAGS & SVs_SMG) {
diff --git a/op.c b/op.c
index 93a9678..eb3dffe 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4505,6 +4505,7 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
     PVOP *pvop;
 
     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
+       || type == OP_RUNCV
        || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
 
     NewOp(1101, pvop, 1, PVOP);
@@ -10283,6 +10284,22 @@ Perl_rpeep(pTHX_ register OP *o)
            }
            break;
 
+       case OP_RUNCV:
+           if (!(o->op_private & OPpOFFBYONE) && !CvCLONE(PL_compcv)) {
+               SV *sv;
+               if (CvUNIQUE(PL_compcv)) sv = &PL_sv_undef;
+               else {
+                   sv = newRV((SV *)PL_compcv);
+                   sv_rvweaken(sv);
+                   SvREADONLY_on(sv);
+               }
+               o->op_type = OP_CONST;
+               o->op_ppaddr = PL_ppaddr[OP_CONST];
+               o->op_flags |= OPf_SPECIAL;
+               cSVOPo->op_sv = sv;
+           }
+           break;
+
        case OP_CUSTOM: {
            Perl_cpeep_t cpeep = 
                XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_peep);
diff --git a/toke.c b/toke.c
index a9b5e49..e5da941 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -7128,7 +7128,7 @@ Perl_yylex(pTHX)
        }
 
        case KEY___SUB__:
-           FUN0(OP_RUNCV);
+           FUN0OP(newPVOP(OP_RUNCV,0,NULL));
 
        case KEY_AUTOLOAD:
        case KEY_DESTROY: