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

11 files changed, 74 insertions, 57 deletions

diff --git a/dump.c b/dump.c
index 6033ed1163..bd11207239 100644
--- 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 386db7906a..d778294718 100644
--- 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 9c4ce51214..4e0695f92b 100644
--- 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 b2309888f1..e128ec969c 100644
--- 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 d59b96207e..29e4984a9e 100644
--- 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 098f83cb0f..e8c43ddb55 100755
--- 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 e4393ee242..ac6d259ecd 100644
--- 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 74060e3677..9a2a6b2539 100644
--- 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 1dcca0bd2f..0b4da4dfef 100644
--- 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 cd1a885f67..bb510f99cc 100644
--- 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 847e4f15ea..0c1829ad74 100644
--- 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)