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
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;
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
#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)
#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_
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)
$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) {
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);
break;
}
#ifdef USE_ITHREADS
- case INSN_REGEX_PADAV: /* 144 */
+ case INSN_REGEX_PADAV: /* 143 */
{
svindex arg;
BGET_svindex(arg);
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);
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 {
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;
}
}
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 */
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);
}
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;
}
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;
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);
#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 */
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'
*/
}
}
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) {
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);
}
#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
}
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);
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);
}
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);
#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);
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++;