diff options
| -rw-r--r-- | dump.c | 3 | ||||
| -rw-r--r-- | ext/Opcode/Opcode.pm | 2 | ||||
| -rw-r--r-- | op.c | 13 | ||||
| -rw-r--r-- | op.h | 2 | ||||
| -rw-r--r-- | opcode.h | 5 | ||||
| -rwxr-xr-x | opcode.pl | 1 | ||||
| -rw-r--r-- | opnames.h | 81 | ||||
| -rw-r--r-- | pp.sym | 1 | ||||
| -rw-r--r-- | pp_ctl.c | 13 | ||||
| -rw-r--r-- | pp_hot.c | 9 | ||||
| -rw-r--r-- | pp_proto.h | 1 |
11 files changed, 74 insertions, 57 deletions
@@ -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 @@ -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 @@ -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. */ @@ -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 */ @@ -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 @@ -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 @@ -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 @@ -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; @@ -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) |