From: Nicholas Clark Date: Sat, 20 May 2006 17:29:52 +0000 (+0000) Subject: Abolish cop_io (the simple way) by storing the value in cop_hints_hash. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=11bcd5dad4f9d911a9454f9d858c2dd0d14ddf2a;p=p5sagit%2Fp5-mst-13.2.git Abolish cop_io (the simple way) by storing the value in cop_hints_hash. Todo - store the in and out values under 2 keys, and avoid the need to create a temporary mortal SV while checking it. p4raw-id: //depot/perl@28258 --- diff --git a/bytecode.pl b/bytecode.pl index 06269e4..cad64bc 100644 --- a/bytecode.pl +++ b/bytecode.pl @@ -499,7 +499,6 @@ cop_filegv cCOP svindex x cop_seq cCOP->cop_seq U32 cop_arybase cCOP I32 x cop_line cCOP->cop_line line_t -cop_io cCOP->cop_io svindex cop_warnings cCOP svindex x main_start PL_main_start opindex main_root PL_main_root opindex diff --git a/cop.h b/cop.h index 21dc228..c11687d 100644 --- a/cop.h +++ b/cop.h @@ -148,7 +148,6 @@ struct cop { line_t cop_line; /* line # of this command */ /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *: */ STRLEN * cop_warnings; /* lexical warnings bitmask */ - SV * cop_io; /* lexical IO defaults */ /* compile time state of %^H. See the comment in op.c for how this is used to recreate a hash to return from caller. */ struct refcounted_he * cop_hints_hash; diff --git a/embed.fnc b/embed.fnc index 097023f..086eb69 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1504,6 +1504,8 @@ Apn |int |my_socketpair |int family|int type|int protocol|int fd[2] pMXE |SV* |sv_setsv_cow |NN SV* dsv|NN SV* ssv #endif +op |const char *|PerlIO_context_layers|NULLOK const char *mode + #if defined(USE_PERLIO) && !defined(USE_SFIO) Ap |int |PerlIO_close |NULLOK PerlIO *f Ap |int |PerlIO_fill |NULLOK PerlIO *f diff --git a/embed.h b/embed.h index df7750c..8a0e3d6 100644 --- a/embed.h +++ b/embed.h @@ -3692,6 +3692,8 @@ #define sv_setsv_cow(a,b) Perl_sv_setsv_cow(aTHX_ a,b) #endif #endif +#ifdef PERL_CORE +#endif #if defined(USE_PERLIO) && !defined(USE_SFIO) #define PerlIO_close(a) Perl_PerlIO_close(aTHX_ a) #define PerlIO_fill(a) Perl_PerlIO_fill(aTHX_ a) diff --git a/ext/B/B.xs b/ext/B/B.xs index 50b959b..afc1c37 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1100,7 +1100,6 @@ LOOP_lastop(o) #define COP_cop_seq(o) o->cop_seq #define COP_arybase(o) CopARYBASE_get(o) #define COP_line(o) CopLINE(o) -#define COP_io(o) o->cop_io #define COP_hints(o) CopHINTS_get(o) MODULE = B PACKAGE = B::COP PREFIX = COP_ @@ -1148,6 +1147,14 @@ COP_warnings(o) B::SV COP_io(o) B::COP o + PPCODE: + if (!(CopHINTS_get(o) & HINT_LEXICAL_IO)) { + ST(0) = &PL_sv_undef; + } else { + ST(0) = Perl_refcounted_he_fetch(aTHX_ o->cop_hints_hash, 0, + "open", 4, 0, 0); + } + XSRETURN(1); U32 COP_hints(o) diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm index 3e73a1f..8ba8cac 100644 --- a/ext/B/B/Asmdata.pm +++ b/ext/B/B/Asmdata.pm @@ -154,26 +154,25 @@ $insn_data{cop_filegv} = [126, \&PUT_svindex, "GET_svindex"]; $insn_data{cop_seq} = [127, \&PUT_U32, "GET_U32"]; $insn_data{cop_arybase} = [128, \&PUT_I32, "GET_I32"]; $insn_data{cop_line} = [129, \&PUT_U32, "GET_U32"]; -$insn_data{cop_io} = [130, \&PUT_svindex, "GET_svindex"]; -$insn_data{cop_warnings} = [131, \&PUT_svindex, "GET_svindex"]; -$insn_data{main_start} = [132, \&PUT_opindex, "GET_opindex"]; -$insn_data{main_root} = [133, \&PUT_opindex, "GET_opindex"]; -$insn_data{main_cv} = [134, \&PUT_svindex, "GET_svindex"]; -$insn_data{curpad} = [135, \&PUT_svindex, "GET_svindex"]; -$insn_data{push_begin} = [136, \&PUT_svindex, "GET_svindex"]; -$insn_data{push_init} = [137, \&PUT_svindex, "GET_svindex"]; -$insn_data{push_end} = [138, \&PUT_svindex, "GET_svindex"]; -$insn_data{curstash} = [139, \&PUT_svindex, "GET_svindex"]; -$insn_data{defstash} = [140, \&PUT_svindex, "GET_svindex"]; -$insn_data{data} = [141, \&PUT_U8, "GET_U8"]; -$insn_data{incav} = [142, \&PUT_svindex, "GET_svindex"]; -$insn_data{load_glob} = [143, \&PUT_svindex, "GET_svindex"]; -$insn_data{regex_padav} = [144, \&PUT_svindex, "GET_svindex"]; -$insn_data{dowarn} = [145, \&PUT_U8, "GET_U8"]; -$insn_data{comppad_name} = [146, \&PUT_svindex, "GET_svindex"]; -$insn_data{xgv_stash} = [147, \&PUT_svindex, "GET_svindex"]; -$insn_data{signal} = [148, \&PUT_strconst, "GET_strconst"]; -$insn_data{formfeed} = [149, \&PUT_svindex, "GET_svindex"]; +$insn_data{cop_warnings} = [130, \&PUT_svindex, "GET_svindex"]; +$insn_data{main_start} = [131, \&PUT_opindex, "GET_opindex"]; +$insn_data{main_root} = [132, \&PUT_opindex, "GET_opindex"]; +$insn_data{main_cv} = [133, \&PUT_svindex, "GET_svindex"]; +$insn_data{curpad} = [134, \&PUT_svindex, "GET_svindex"]; +$insn_data{push_begin} = [135, \&PUT_svindex, "GET_svindex"]; +$insn_data{push_init} = [136, \&PUT_svindex, "GET_svindex"]; +$insn_data{push_end} = [137, \&PUT_svindex, "GET_svindex"]; +$insn_data{curstash} = [138, \&PUT_svindex, "GET_svindex"]; +$insn_data{defstash} = [139, \&PUT_svindex, "GET_svindex"]; +$insn_data{data} = [140, \&PUT_U8, "GET_U8"]; +$insn_data{incav} = [141, \&PUT_svindex, "GET_svindex"]; +$insn_data{load_glob} = [142, \&PUT_svindex, "GET_svindex"]; +$insn_data{regex_padav} = [143, \&PUT_svindex, "GET_svindex"]; +$insn_data{dowarn} = [144, \&PUT_U8, "GET_U8"]; +$insn_data{comppad_name} = [145, \&PUT_svindex, "GET_svindex"]; +$insn_data{xgv_stash} = [146, \&PUT_svindex, "GET_svindex"]; +$insn_data{signal} = [147, \&PUT_strconst, "GET_strconst"]; +$insn_data{formfeed} = [148, \&PUT_svindex, "GET_svindex"]; my ($insn_name, $insn_data); while (($insn_name, $insn_data) = each %insn_data) { diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c index 3738ad5..2b7296a 100644 --- a/ext/ByteLoader/byterun.c +++ b/ext/ByteLoader/byterun.c @@ -975,98 +975,91 @@ byterun(pTHX_ register struct byteloader_state *bstate) cCOP->cop_line = arg; break; } - case INSN_COP_IO: /* 130 */ - { - svindex arg; - BGET_svindex(arg); - cCOP->cop_io = arg; - break; - } - case INSN_COP_WARNINGS: /* 131 */ + case INSN_COP_WARNINGS: /* 130 */ { svindex arg; BGET_svindex(arg); BSET_cop_warnings(cCOP, arg); break; } - case INSN_MAIN_START: /* 132 */ + case INSN_MAIN_START: /* 131 */ { opindex arg; BGET_opindex(arg); PL_main_start = arg; break; } - case INSN_MAIN_ROOT: /* 133 */ + case INSN_MAIN_ROOT: /* 132 */ { opindex arg; BGET_opindex(arg); PL_main_root = arg; break; } - case INSN_MAIN_CV: /* 134 */ + case INSN_MAIN_CV: /* 133 */ { svindex arg; BGET_svindex(arg); *(SV**)&PL_main_cv = arg; break; } - case INSN_CURPAD: /* 135 */ + case INSN_CURPAD: /* 134 */ { svindex arg; BGET_svindex(arg); BSET_curpad(PL_curpad, arg); break; } - case INSN_PUSH_BEGIN: /* 136 */ + case INSN_PUSH_BEGIN: /* 135 */ { svindex arg; BGET_svindex(arg); BSET_push_begin(PL_beginav, arg); break; } - case INSN_PUSH_INIT: /* 137 */ + case INSN_PUSH_INIT: /* 136 */ { svindex arg; BGET_svindex(arg); BSET_push_init(PL_initav, arg); break; } - case INSN_PUSH_END: /* 138 */ + case INSN_PUSH_END: /* 137 */ { svindex arg; BGET_svindex(arg); BSET_push_end(PL_endav, arg); break; } - case INSN_CURSTASH: /* 139 */ + case INSN_CURSTASH: /* 138 */ { svindex arg; BGET_svindex(arg); *(SV**)&PL_curstash = arg; break; } - case INSN_DEFSTASH: /* 140 */ + case INSN_DEFSTASH: /* 139 */ { svindex arg; BGET_svindex(arg); *(SV**)&PL_defstash = arg; break; } - case INSN_DATA: /* 141 */ + case INSN_DATA: /* 140 */ { U8 arg; BGET_U8(arg); BSET_data(none, arg); break; } - case INSN_INCAV: /* 142 */ + case INSN_INCAV: /* 141 */ { svindex arg; BGET_svindex(arg); *(SV**)&GvAV(PL_incgv) = arg; break; } - case INSN_LOAD_GLOB: /* 143 */ + case INSN_LOAD_GLOB: /* 142 */ { svindex arg; BGET_svindex(arg); @@ -1074,7 +1067,7 @@ byterun(pTHX_ register struct byteloader_state *bstate) break; } #ifdef USE_ITHREADS - case INSN_REGEX_PADAV: /* 144 */ + case INSN_REGEX_PADAV: /* 143 */ { svindex arg; BGET_svindex(arg); @@ -1082,35 +1075,35 @@ byterun(pTHX_ register struct byteloader_state *bstate) break; } #endif - case INSN_DOWARN: /* 145 */ + case INSN_DOWARN: /* 144 */ { U8 arg; BGET_U8(arg); PL_dowarn = arg; break; } - case INSN_COMPPAD_NAME: /* 146 */ + case INSN_COMPPAD_NAME: /* 145 */ { svindex arg; BGET_svindex(arg); *(SV**)&PL_comppad_name = arg; break; } - case INSN_XGV_STASH: /* 147 */ + case INSN_XGV_STASH: /* 146 */ { svindex arg; BGET_svindex(arg); *(SV**)&GvSTASH(bstate->bs_sv) = arg; break; } - case INSN_SIGNAL: /* 148 */ + case INSN_SIGNAL: /* 147 */ { strconst arg; BGET_strconst(arg); BSET_signal(bstate->bs_sv, arg); break; } - case INSN_FORMFEED: /* 149 */ + case INSN_FORMFEED: /* 148 */ { svindex arg; BGET_svindex(arg); diff --git a/ext/ByteLoader/byterun.h b/ext/ByteLoader/byterun.h index 0ba48c6..75c1ba0 100644 --- a/ext/ByteLoader/byterun.h +++ b/ext/ByteLoader/byterun.h @@ -165,27 +165,26 @@ enum { INSN_COP_SEQ, /* 127 */ INSN_COP_ARYBASE, /* 128 */ INSN_COP_LINE, /* 129 */ - INSN_COP_IO, /* 130 */ - INSN_COP_WARNINGS, /* 131 */ - INSN_MAIN_START, /* 132 */ - INSN_MAIN_ROOT, /* 133 */ - INSN_MAIN_CV, /* 134 */ - INSN_CURPAD, /* 135 */ - INSN_PUSH_BEGIN, /* 136 */ - INSN_PUSH_INIT, /* 137 */ - INSN_PUSH_END, /* 138 */ - INSN_CURSTASH, /* 139 */ - INSN_DEFSTASH, /* 140 */ - INSN_DATA, /* 141 */ - INSN_INCAV, /* 142 */ - INSN_LOAD_GLOB, /* 143 */ - INSN_REGEX_PADAV, /* 144 */ - INSN_DOWARN, /* 145 */ - INSN_COMPPAD_NAME, /* 146 */ - INSN_XGV_STASH, /* 147 */ - INSN_SIGNAL, /* 148 */ - INSN_FORMFEED, /* 149 */ - MAX_INSN = 149 + INSN_COP_WARNINGS, /* 130 */ + INSN_MAIN_START, /* 131 */ + INSN_MAIN_ROOT, /* 132 */ + INSN_MAIN_CV, /* 133 */ + INSN_CURPAD, /* 134 */ + INSN_PUSH_BEGIN, /* 135 */ + INSN_PUSH_INIT, /* 136 */ + INSN_PUSH_END, /* 137 */ + INSN_CURSTASH, /* 138 */ + INSN_DEFSTASH, /* 139 */ + INSN_DATA, /* 140 */ + INSN_INCAV, /* 141 */ + INSN_LOAD_GLOB, /* 142 */ + INSN_REGEX_PADAV, /* 143 */ + INSN_DOWARN, /* 144 */ + INSN_COMPPAD_NAME, /* 145 */ + INSN_XGV_STASH, /* 146 */ + INSN_SIGNAL, /* 147 */ + INSN_FORMFEED, /* 148 */ + MAX_INSN = 148 }; enum { diff --git a/mg.c b/mg.c index 217eb59..3e8ca7c 100644 --- a/mg.c +++ b/mg.c @@ -758,10 +758,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) SvTAINTED_off(sv); } else if (strEQ(remaining, "PEN")) { - if (!PL_compiling.cop_io) + if (!(CopHINTS_get(&PL_compiling) & HINT_LEXICAL_IO)) sv_setsv(sv, &PL_sv_undef); else { - sv_setsv(sv, PL_compiling.cop_io); + sv_setsv(sv, + Perl_refcounted_he_fetch(aTHX_ + PL_compiling.cop_hints_hash, + 0, "open", 4, 0, 0)); } } break; @@ -2230,10 +2233,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) } } else if (strEQ(mg->mg_ptr, "\017PEN")) { - if (!PL_compiling.cop_io) - PL_compiling.cop_io = newSVsv(sv); - else - sv_setsv(PL_compiling.cop_io,sv); + PL_compiling.cop_hints |= HINT_LEXICAL_IO; + PL_hints |= HINT_LOCALIZE_HH | HINT_LEXICAL_IO; + PL_compiling.cop_hints_hash + = Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash, + sv_2mortal(newSVpvs("open")), sv); } break; case '\020': /* ^P */ diff --git a/op.c b/op.c index bf942e1..0e668fb 100644 --- a/op.c +++ b/op.c @@ -495,13 +495,6 @@ S_cop_free(pTHX_ COP* cop) CopSTASH_free(cop); if (! specialWARN(cop->cop_warnings)) PerlMemShared_free(cop->cop_warnings); - if (! specialCopIO(cop->cop_io)) { -#ifdef USE_ITHREADS - NOOP; -#else - SvREFCNT_dec(cop->cop_io); -#endif - } Perl_refcounted_he_free(aTHX_ cop->cop_hints_hash); } @@ -1977,11 +1970,6 @@ Perl_block_start(pTHX_ int full) PL_hints &= ~HINT_BLOCK_SCOPE; SAVECOMPILEWARNINGS(); PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings); - SAVESPTR(PL_compiling.cop_io); - if (! specialCopIO(PL_compiling.cop_io)) { - PL_compiling.cop_io = newSVsv(PL_compiling.cop_io) ; - SAVEFREESV(PL_compiling.cop_io) ; - } return retval; } @@ -3950,10 +3938,6 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) CopHINTS and a possible value in cop_hints_hash, so no need to copy it. */ cop->cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings); - if (specialCopIO(PL_curcop->cop_io)) - cop->cop_io = PL_curcop->cop_io; - else - cop->cop_io = newSVsv(PL_curcop->cop_io) ; cop->cop_hints_hash = PL_curcop->cop_hints_hash; if (cop->cop_hints_hash) { HINTS_REFCNT_LOCK; diff --git a/perl.c b/perl.c index 7d71030..3ddbbfb 100644 --- a/perl.c +++ b/perl.c @@ -1053,9 +1053,6 @@ perl_destruct(pTHXx) if (!specialWARN(PL_compiling.cop_warnings)) PerlMemShared_free(PL_compiling.cop_warnings); PL_compiling.cop_warnings = NULL; - if (!specialCopIO(PL_compiling.cop_io)) - SvREFCNT_dec(PL_compiling.cop_io); - PL_compiling.cop_io = NULL; Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash); PL_compiling.cop_hints_hash = NULL; CopFILE_free(&PL_compiling); diff --git a/perl.h b/perl.h index 364c409..cdb2b86 100644 --- a/perl.h +++ b/perl.h @@ -4231,6 +4231,7 @@ enum { /* pass one of these to get_vtbl */ #define HINT_NEW_STRING 0x00008000 #define HINT_NEW_RE 0x00010000 #define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */ +#define HINT_LEXICAL_IO 0x00040000 /* ${^OPEN} is set */ #define HINT_RE_TAINT 0x00100000 /* re pragma */ #define HINT_RE_EVAL 0x00200000 /* re pragma */ diff --git a/perlio.c b/perlio.c index f883fe9..d76a96f 100644 --- a/perlio.c +++ b/perlio.c @@ -1408,20 +1408,23 @@ Perl_PerlIO_fileno(pTHX_ PerlIO *f) Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f)); } -static const char * -PerlIO_context_layers(pTHX_ const char *mode) +const char * +Perl_PerlIO_context_layers(pTHX_ const char *mode) { dVAR; const char *type = NULL; /* * Need to supply default layer info from open.pm */ - if (PL_curcop) { - SV * const layers = PL_curcop->cop_io; - if (layers) { + if (PL_curcop && PL_curcop->cop_hints & HINT_LEXICAL_IO) { + SV * const layers + = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, 0, + "open", 4, 0, 0); + assert(layers); + if (SvOK(layers)) { STRLEN len; type = SvPV_const(layers, len); - if (type && mode[0] != 'r') { + if (type && mode && mode[0] != 'r') { /* * Skip to write part, which is separated by a '\0' */ @@ -1491,7 +1494,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers, } } if (!layers || !*layers) - layers = PerlIO_context_layers(aTHX_ mode); + layers = Perl_PerlIO_context_layers(aTHX_ mode); if (layers && *layers) { PerlIO_list_t *av; if (incdef) { @@ -1528,7 +1531,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, if (!f && narg == 1 && *args == &PL_sv_undef) { if ((f = PerlIO_tmpfile())) { if (!layers || !*layers) - layers = PerlIO_context_layers(aTHX_ mode); + layers = Perl_PerlIO_context_layers(aTHX_ mode); if (layers && *layers) PerlIO_apply_layers(aTHX_ f, mode, layers); } diff --git a/perlio.h b/perlio.h index d1e3dd5..94a34f9 100644 --- a/perlio.h +++ b/perlio.h @@ -174,8 +174,6 @@ PERL_EXPORT_C void PerlIO_clone(pTHX_ PerlInterpreter *proto, #endif /* ifndef PERLIO_NOT_STDIO */ #endif /* PERLIO_IS_STDIO */ -#define specialCopIO(sv) ((sv) == NULL) - /* ----------- fill in things that have not got #define'd ---------- */ #ifndef Fpos_t diff --git a/pp_ctl.c b/pp_ctl.c index 1cdf592..c5b4755 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3373,8 +3373,6 @@ PP(pp_require) } else PL_compiling.cop_warnings = pWARN_STD ; - SAVESPTR(PL_compiling.cop_io); - PL_compiling.cop_io = NULL; if (filter_sub || filter_cache) { SV * const datasv = filter_add(S_run_user_filter, NULL); @@ -3468,13 +3466,6 @@ PP(pp_entereval) GvHV(PL_hintgv) = saved_hh; SAVECOMPILEWARNINGS(); PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings); - SAVESPTR(PL_compiling.cop_io); - if (specialCopIO(PL_curcop->cop_io)) - PL_compiling.cop_io = PL_curcop->cop_io; - else { - PL_compiling.cop_io = newSVsv(PL_curcop->cop_io); - SAVEFREESV(PL_compiling.cop_io); - } if (PL_compiling.cop_hints_hash) { Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash); } diff --git a/pp_sys.c b/pp_sys.c index a111f1e..f2ff7db 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -330,7 +330,7 @@ PP(pp_backtick) mode = "rt"; fp = PerlProc_popen(tmps, mode); if (fp) { - const char * const type = PL_curcop->cop_io ? SvPV_nolen_const(PL_curcop->cop_io) : NULL; + const char * const type = Perl_PerlIO_context_layers(aTHX_ NULL); if (type && *type) PerlIO_apply_layers(aTHX_ fp,mode,type); diff --git a/proto.h b/proto.h index 609341f..0fca726 100644 --- a/proto.h +++ b/proto.h @@ -4037,6 +4037,8 @@ PERL_CALLCONV SV* Perl_sv_setsv_cow(pTHX_ SV* dsv, SV* ssv) #endif +PERL_CALLCONV const char * Perl_PerlIO_context_layers(pTHX_ const char *mode); + #if defined(USE_PERLIO) && !defined(USE_SFIO) PERL_CALLCONV int Perl_PerlIO_close(pTHX_ PerlIO *f); PERL_CALLCONV int Perl_PerlIO_fill(pTHX_ PerlIO *f); diff --git a/sv.c b/sv.c index 8b17f37..d6e307d 100644 --- a/sv.c +++ b/sv.c @@ -10963,8 +10963,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling); PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings); - if (!specialCopIO(PL_compiling.cop_io)) - PL_compiling.cop_io = sv_dup_inc(PL_compiling.cop_io, param); if (PL_compiling.cop_hints_hash) { HINTS_REFCNT_LOCK; PL_compiling.cop_hints_hash->refcounted_he_refcnt++;