Re: [PATCH] Splitting OP_CONST (Was: pp_const, not, that, hot?)

Message-ID: <47B60D72.50708@profvince.com>
Date: Fri, 15 Feb 2008 23:08:50 +0100

p4raw-id: //depot/perl@33356

diff --git a/dump.c b/dump.c
index 6033ed1..bd11207 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1065,6 +1065,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 #endif
        break;
     case OP_CONST:
+    case OP_HINTSEVAL:
     case OP_METHOD_NAMED:
 #ifndef USE_ITHREADS
        /* with ITHREADS, consts are stored in the pad, and the right pad
@@ -2000,6 +2001,7 @@ Perl_debop(pTHX_ const OP *o)
     Perl_deb(aTHX_ "%s", OP_NAME(o));
     switch (o->op_type) {
     case OP_CONST:
+    case OP_HINTSEVAL:
        PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
        break;
     case OP_GVSV:
@@ -2839,6 +2841,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
 #endif
        break;
     case OP_CONST:
+    case OP_HINTSEVAL:
     case OP_METHOD_NAMED:
 #ifndef USE_ITHREADS
        /* with ITHREADS, consts are stored in the pad, and the right pad

diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index 386db79..d778294 100644 (file)
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -557,6 +557,8 @@ about calling environment and args.
     tied -- can be used to access object implementing a tie
     pack unpack -- can be used to create/use memory pointers
 
+    hintseval -- constant op holding eval hints
+
     entereval -- can be used to hide code from initial compile
 
     reset

diff --git a/op.c b/op.c
index 9c4ce51..4e0695f 100644 (file)
--- a/op.c
+++ b/op.c
@@ -580,6 +580,7 @@ Perl_op_clear(pTHX_ OP *o)
        break;
     case OP_METHOD_NAMED:
     case OP_CONST:
+    case OP_HINTSEVAL:
        SvREFCNT_dec(cSVOPo->op_sv);
        cSVOPo->op_sv = NULL;
 #ifdef USE_ITHREADS
@@ -6468,11 +6469,8 @@ Perl_ck_eval(pTHX_ OP *o)
     }
     o->op_targ = (PADOFFSET)PL_hints;
     if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
-       /* Store a copy of %^H that pp_entereval can pick up.
-          OPf_SPECIAL flags the opcode as being for this purpose,
-          so that it in turn will return a copy at every
-          eval.*/
-       OP *hhop = newSVOP(OP_CONST, OPf_SPECIAL,
+       /* Store a copy of %^H that pp_entereval can pick up. */
+       OP *hhop = newSVOP(OP_HINTSEVAL, 0,
                           (SV*)Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv)));
        cUNOPo->op_first->op_sibling = hhop;
        o->op_private |= OPpEVAL_HAS_HH;
@@ -8225,20 +8223,21 @@ Perl_peep(pTHX_ register OP *o)
            if (cSVOPo->op_private & OPpCONST_STRICT)
                no_bareword_allowed(o);
 #ifdef USE_ITHREADS
+       case OP_HINTSEVAL:
        case OP_METHOD_NAMED:
            /* Relocate sv to the pad for thread safety.
             * Despite being a "constant", the SV is written to,
             * for reference counts, sv_upgrade() etc. */
            if (cSVOP->op_sv) {
                const PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
-               if (o->op_type == OP_CONST && SvPADTMP(cSVOPo->op_sv)) {
+               if (o->op_type != OP_METHOD_NAMED && SvPADTMP(cSVOPo->op_sv)) {
                    /* If op_sv is already a PADTMP then it is being used by
                     * some pad, so make a copy. */
                    sv_setsv(PAD_SVl(ix),cSVOPo->op_sv);
                    SvREADONLY_on(PAD_SVl(ix));
                    SvREFCNT_dec(cSVOPo->op_sv);
                }
-               else if (o->op_type == OP_CONST
+               else if (o->op_type != OP_METHOD_NAMED
                         && cSVOPo->op_sv == &PL_sv_undef) {
                    /* PL_sv_undef is hack - it's unsafe to store it in the
                       AV that is the pad, because av_fetch treats values of

diff --git a/op.h b/op.h
index b230988..e128ec9 100644 (file)
--- a/op.h
+++ b/op.h
@@ -112,8 +112,6 @@ Deprecated.  Use C<GIMME_V> instead.
 #define OPf_STACKED    64      /* Some arg is arriving on the stack. */
 #define OPf_SPECIAL    128     /* Do something weird for this op: */
                                /*  On local LVAL, don't init local value. */
-                               /*  On OP_CONST, value is the hints hash for
-                                   eval, so return a copy from pp_const() */
                                /*  On OP_SORT, subroutine is inlined. */
                                /*  On OP_NOT, inversion was implicit. */
                                /*  On OP_LEAVE, don't restore curpm. */

diff --git a/opcode.h b/opcode.h
index d59b962..29e4984 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -358,6 +358,7 @@ EXTCONST char* const PL_op_name[] = {
        "semctl",
        "require",
        "dofile",
+       "hintseval",
        "entereval",
        "leaveeval",
        "entertry",
@@ -729,6 +730,7 @@ EXTCONST char* const PL_op_desc[] = {
        "semctl",
        "require",
        "do \"file\"",
+       "eval hints",
        "eval \"string\"",
        "eval \"string\" exit",
        "eval {block}",
@@ -1114,6 +1116,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
        MEMBER_TO_FPTR(Perl_pp_semctl),
        MEMBER_TO_FPTR(Perl_pp_require),
        MEMBER_TO_FPTR(Perl_pp_require),        /* Perl_pp_dofile */
+       MEMBER_TO_FPTR(Perl_pp_hintseval),
        MEMBER_TO_FPTR(Perl_pp_entereval),
        MEMBER_TO_FPTR(Perl_pp_leaveeval),
        MEMBER_TO_FPTR(Perl_pp_entertry),
@@ -1496,6 +1499,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        MEMBER_TO_FPTR(Perl_ck_fun),    /* semctl */
        MEMBER_TO_FPTR(Perl_ck_require),        /* require */
        MEMBER_TO_FPTR(Perl_ck_fun),    /* dofile */
+       MEMBER_TO_FPTR(Perl_ck_svconst),        /* hintseval */
        MEMBER_TO_FPTR(Perl_ck_eval),   /* entereval */
        MEMBER_TO_FPTR(Perl_ck_null),   /* leaveeval */
        MEMBER_TO_FPTR(Perl_ck_null),   /* entertry */
@@ -1872,6 +1876,7 @@ EXTCONST U32 PL_opargs[] = {
        0x0222281d,     /* semctl */
        0x000136c0,     /* require */
        0x00002240,     /* dofile */
+       0x00000c04,     /* hintseval */
        0x00003640,     /* entereval */
        0x00002200,     /* leaveeval */
        0x00000600,     /* entertry */

diff --git a/opcode.pl b/opcode.pl
index 098f83c..e8c43dd 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -1052,6 +1052,7 @@ semctl            semctl                  ck_fun          imst@   S S S S
 
 require                require                 ck_require      du%     S?
 dofile         do "file"               ck_fun          d1      S
+hintseval      eval hints              ck_svconst      s$
 entereval      eval "string"           ck_eval         d%      S
 leaveeval      eval "string" exit      ck_null         1       S
 #evalonce      eval constant string    ck_null         d1      S

diff --git a/opnames.h b/opnames.h
index e4393ee..ac6d259 100644 (file)
--- a/opnames.h
+++ b/opnames.h
@@ -340,49 +340,50 @@ typedef enum opcode {
        OP_SEMCTL        = 322,
        OP_REQUIRE       = 323,
        OP_DOFILE        = 324,
-       OP_ENTEREVAL     = 325,
-       OP_LEAVEEVAL     = 326,
-       OP_ENTERTRY      = 327,
-       OP_LEAVETRY      = 328,
-       OP_GHBYNAME      = 329,
-       OP_GHBYADDR      = 330,
-       OP_GHOSTENT      = 331,
-       OP_GNBYNAME      = 332,
-       OP_GNBYADDR      = 333,
-       OP_GNETENT       = 334,
-       OP_GPBYNAME      = 335,
-       OP_GPBYNUMBER    = 336,
-       OP_GPROTOENT     = 337,
-       OP_GSBYNAME      = 338,
-       OP_GSBYPORT      = 339,
-       OP_GSERVENT      = 340,
-       OP_SHOSTENT      = 341,
-       OP_SNETENT       = 342,
-       OP_SPROTOENT     = 343,
-       OP_SSERVENT      = 344,
-       OP_EHOSTENT      = 345,
-       OP_ENETENT       = 346,
-       OP_EPROTOENT     = 347,
-       OP_ESERVENT      = 348,
-       OP_GPWNAM        = 349,
-       OP_GPWUID        = 350,
-       OP_GPWENT        = 351,
-       OP_SPWENT        = 352,
-       OP_EPWENT        = 353,
-       OP_GGRNAM        = 354,
-       OP_GGRGID        = 355,
-       OP_GGRENT        = 356,
-       OP_SGRENT        = 357,
-       OP_EGRENT        = 358,
-       OP_GETLOGIN      = 359,
-       OP_SYSCALL       = 360,
-       OP_LOCK          = 361,
-       OP_ONCE          = 362,
-       OP_CUSTOM        = 363,
+       OP_HINTSEVAL     = 325,
+       OP_ENTEREVAL     = 326,
+       OP_LEAVEEVAL     = 327,
+       OP_ENTERTRY      = 328,
+       OP_LEAVETRY      = 329,
+       OP_GHBYNAME      = 330,
+       OP_GHBYADDR      = 331,
+       OP_GHOSTENT      = 332,
+       OP_GNBYNAME      = 333,
+       OP_GNBYADDR      = 334,
+       OP_GNETENT       = 335,
+       OP_GPBYNAME      = 336,
+       OP_GPBYNUMBER    = 337,
+       OP_GPROTOENT     = 338,
+       OP_GSBYNAME      = 339,
+       OP_GSBYPORT      = 340,
+       OP_GSERVENT      = 341,
+       OP_SHOSTENT      = 342,
+       OP_SNETENT       = 343,
+       OP_SPROTOENT     = 344,
+       OP_SSERVENT      = 345,
+       OP_EHOSTENT      = 346,
+       OP_ENETENT       = 347,
+       OP_EPROTOENT     = 348,
+       OP_ESERVENT      = 349,
+       OP_GPWNAM        = 350,
+       OP_GPWUID        = 351,
+       OP_GPWENT        = 352,
+       OP_SPWENT        = 353,
+       OP_EPWENT        = 354,
+       OP_GGRNAM        = 355,
+       OP_GGRGID        = 356,
+       OP_GGRENT        = 357,
+       OP_SGRENT        = 358,
+       OP_EGRENT        = 359,
+       OP_GETLOGIN      = 360,
+       OP_SYSCALL       = 361,
+       OP_LOCK          = 362,
+       OP_ONCE          = 363,
+       OP_CUSTOM        = 364,
        OP_max          
 } opcode;
 
-#define MAXO 364
+#define MAXO 365
 #define OP_phoney_INPUT_ONLY -1
 #define OP_phoney_OUTPUT_ONLY -2
 

diff --git a/pp.sym b/pp.sym
index 74060e3..9a2a6b2 100644 (file)
--- a/pp.sym
+++ b/pp.sym
@@ -369,6 +369,7 @@ Perl_pp_semget
 Perl_pp_semctl
 Perl_pp_require
 Perl_pp_dofile
+Perl_pp_hintseval
 Perl_pp_entereval
 Perl_pp_leaveeval
 Perl_pp_entertry

diff --git a/pp_ctl.c b/pp_ctl.c
index 1dcca0b..0b4da4d 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3610,6 +3610,19 @@ PP(pp_require)
     return op;
 }
 
+/* This is a op added to hold the hints hash for
+   pp_entereval. The hash can be modified by the code
+   being eval'ed, so we return a copy instead. */
+
+PP(pp_hintseval)
+{
+    dVAR;
+    dSP;
+    mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv));
+    RETURN;
+}
+
+
 PP(pp_entereval)
 {
     dVAR; dSP;

diff --git a/pp_hot.c b/pp_hot.c
index cd1a885..bb510f9 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -39,14 +39,7 @@ PP(pp_const)
 {
     dVAR;
     dSP;
-    if ( PL_op->op_flags & OPf_SPECIAL )
-        /* This is a const op added to hold the hints hash for
-           pp_entereval. The hash can be modified by the code
-           being eval'ed, so we return a copy instead. */
-        mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv));
-    else
-        /* Normal const. */
-        XPUSHs(cSVOP_sv);
+    XPUSHs(cSVOP_sv);
     RETURN;
 }
 

diff --git a/pp_proto.h b/pp_proto.h
index 847e4f1..0c1829a 100644 (file)
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -370,6 +370,7 @@ PERL_PPDEF(Perl_pp_semget)
 PERL_PPDEF(Perl_pp_semctl)
 PERL_PPDEF(Perl_pp_require)
 PERL_PPDEF(Perl_pp_dofile)
+PERL_PPDEF(Perl_pp_hintseval)
 PERL_PPDEF(Perl_pp_entereval)
 PERL_PPDEF(Perl_pp_leaveeval)
 PERL_PPDEF(Perl_pp_entertry)