move PL_rsfp into the PL_parser struct

and simplify its creation and destruction

p4raw-id: //depot/perl@31199

13 files changed, 82 insertions, 86 deletions

diff --git a/embed.fnc b/embed.fnc
index fcb5b56653..97e3422014 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -403,7 +403,7 @@ p	|OP*	|jmaybe		|NN OP* arg
 pP	|I32	|keyword	|NN const char* d|I32 len|bool all_keywords
 Ap	|void	|leave_scope	|I32 base
 EXp	|void	|lex_end
-p	|void	|lex_start	|NULLOK SV* line
+p	|void	|lex_start	|NULLOK SV* line|NULLOK PerlIO *rsfp
 Ap	|void	|op_null	|NN OP* o
 EXp	|void	|op_clear	|NN OP* o
 Ap	|void	|op_refcnt_lock
@@ -1244,7 +1244,7 @@ s	|void	|Slab_to_rw	|NN void *op
 #endif
 
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
-s	|void	|find_beginning	|NN SV* linestr_sv
+s	|void	|find_beginning	|NN SV* linestr_sv|NN PerlIO *rsfp
 s	|void	|forbid_setid	|const char flag|const int suidscript
 s	|void	|incpush	|NULLOK const char *dir|bool addsubdirs|bool addoldvers|bool usesep|bool canrelocate
 s	|void	|init_interp
@@ -1256,11 +1256,13 @@ s	|void	|init_predump_symbols
 rs	|void	|my_exit_jump
 s	|void	|nuke_stacks
 s	|int	|open_script	|NN const char *scriptname|bool dosearch \
-				|NN SV *sv|NN int *suidscript
+				|NN SV *sv|NN int *suidscript|NN PerlIO **rsfpp
 s	|void	|usage		|NN const char *name
 s	|void	|validate_suid	|NN const char *validarg \
 				|NN const char *scriptname|int fdscript \
-				|int suidscript|NN SV* linestr_sv
+				|int suidscript|NN SV* linestr_sv \
+				|NN PerlIO *rsfp
+
 #  if defined(IAMSUID)
 s	|int	|fd_on_nosuid_fs|int fd
 #  endif
diff --git a/embed.h b/embed.h
index c076e84335..1737ad3e6c 100644
--- a/embed.h
+++ b/embed.h
@@ -2661,7 +2661,7 @@
 #define lex_end()		Perl_lex_end(aTHX)
 #endif
 #ifdef PERL_CORE
-#define lex_start(a)		Perl_lex_start(aTHX_ a)
+#define lex_start(a,b)		Perl_lex_start(aTHX_ a,b)
 #endif
 #define op_null(a)		Perl_op_null(aTHX_ a)
 #if defined(PERL_CORE) || defined(PERL_EXT)
@@ -3517,7 +3517,7 @@
 #endif
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
-#define find_beginning(a)	S_find_beginning(aTHX_ a)
+#define find_beginning(a,b)	S_find_beginning(aTHX_ a,b)
 #define forbid_setid(a,b)	S_forbid_setid(aTHX_ a,b)
 #define incpush(a,b,c,d,e)	S_incpush(aTHX_ a,b,c,d,e)
 #define init_interp()		S_init_interp(aTHX)
@@ -3528,9 +3528,9 @@
 #define init_predump_symbols()	S_init_predump_symbols(aTHX)
 #define my_exit_jump()		S_my_exit_jump(aTHX)
 #define nuke_stacks()		S_nuke_stacks(aTHX)
-#define open_script(a,b,c,d)	S_open_script(aTHX_ a,b,c,d)
+#define open_script(a,b,c,d,e)	S_open_script(aTHX_ a,b,c,d,e)
 #define usage(a)		S_usage(aTHX_ a)
-#define validate_suid(a,b,c,d,e)	S_validate_suid(aTHX_ a,b,c,d,e)
+#define validate_suid(a,b,c,d,e,f)	S_validate_suid(aTHX_ a,b,c,d,e,f)
 #endif
 #  if defined(IAMSUID)
 #ifdef PERL_CORE
diff --git a/embedvar.h b/embedvar.h
index f5334b5d06..338db265dc 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -298,7 +298,6 @@
 #define PL_rehash_seed		(vTHX->Irehash_seed)
 #define PL_rehash_seed_set	(vTHX->Irehash_seed_set)
 #define PL_replgv		(vTHX->Ireplgv)
-#define PL_rsfp			(vTHX->Irsfp)
 #define PL_rsfp_filters		(vTHX->Irsfp_filters)
 #define PL_runops		(vTHX->Irunops)
 #define PL_runops_dbg		(vTHX->Irunops_dbg)
@@ -548,7 +547,6 @@
 #define PL_Irehash_seed		PL_rehash_seed
 #define PL_Irehash_seed_set	PL_rehash_seed_set
 #define PL_Ireplgv		PL_replgv
-#define PL_Irsfp		PL_rsfp
 #define PL_Irsfp_filters	PL_rsfp_filters
 #define PL_Irunops		PL_runops
 #define PL_Irunops_dbg		PL_runops_dbg
diff --git a/ext/Devel/PPPort/parts/inc/variables b/ext/Devel/PPPort/parts/inc/variables
index 8901509ea7..1011b1a084 100644
--- a/ext/Devel/PPPort/parts/inc/variables
+++ b/ext/Devel/PPPort/parts/inc/variables
@@ -97,6 +97,7 @@ __NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT;
 #  define PL_PARSER_EXISTS
 #  define PL_expect   (PL_parser ? PL_parser->expect : 0)
 #  define PL_copline  (PL_parser ? PL_parser->copline : 0)
+#  define PL_rsfp     (PL_parser ? PL_parser->rsfp : 0)
 #endif
 
 =xsinit
@@ -227,7 +228,11 @@ other_variables()
 		ppp_TESTVAR(PL_perl_destruct_level);
 		ppp_TESTVAR(PL_perldb);
 		ppp_TESTVAR(PL_rsfp_filters);
+#ifdef PL_PARSER_EXISTS
+		ppp_TESTVAR(PL_parser); /* just any var that isn't PL_expect */
+#else
 		ppp_TESTVAR(PL_rsfp);
+#endif
 		ppp_TESTVAR(PL_stack_base);
 		ppp_TESTVAR(PL_stack_sp);
 		ppp_TESTVAR(PL_statcache);
diff --git a/intrpvar.h b/intrpvar.h
index e2c7b1942f..6f88ca723c 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -214,7 +214,6 @@ PERLVAR(Imodglobal,	HV *)		/* per-interp module data */
 
 /* these used to be in global before 5.004_68 */
 PERLVARI(Iprofiledata,	U32 *,	NULL)	/* table of ops, counts */
-PERLVARI(Irsfp,	PerlIO * VOL,	NULL)	/* current source file pointer */
 PERLVARI(Irsfp_filters,	AV *,	NULL)	/* keeps active source filters */
 
 PERLVAR(Icompiling,	COP)		/* compiling/done executing marker */
diff --git a/op.c b/op.c
index 40b415d924..701569548f 100644
--- a/op.c
+++ b/op.c
@@ -3866,7 +3866,7 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
 
     ENTER;
     SAVEVPTR(PL_curcop);
-    lex_start(NULL);
+    lex_start(NULL, NULL);
     utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
 	    veop, modname, imop);
     LEAVE;
diff --git a/parser.h b/parser.h
index 1df14b4210..082e493fd8 100644
--- a/parser.h
+++ b/parser.h
@@ -70,6 +70,7 @@ typedef struct yy_parser {
     char	*last_uni;	/* position of last named-unary op */
     char	*last_lop;	/* position of last list operator */
     U8		lex_state;	/* next token is determined */
+    PerlIO	*rsfp;		/* current source file pointer */
 
 #ifdef PERL_MAD
     SV		*endwhite;
diff --git a/perl.c b/perl.c
index da52f85ecb..d4abea89fb 100644
--- a/perl.c
+++ b/perl.c
@@ -868,9 +868,10 @@ perl_destruct(pTHXx)
 
     /* loosen bonds of global variables */
 
-    if(PL_rsfp) {
-	(void)PerlIO_close(PL_rsfp);
-	PL_rsfp = NULL;
+    /* XXX can PL_parser still be non-null here? */
+    if(PL_parser && PL_parser->rsfp) {
+	(void)PerlIO_close(PL_parser->rsfp);
+	PL_parser->rsfp = NULL;
     }
 
     /* Filters for program text */
@@ -1654,7 +1655,7 @@ STATIC void *
 S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 {
     dVAR;
-    PerlIO *tmpfp;
+    PerlIO *rsfp;
     int argc = PL_origargc;
     char **argv = PL_origargv;
     const char *scriptname = NULL;
@@ -2112,9 +2113,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     {
 	int suidscript;
 	const int fdscript
-	    = open_script(scriptname, dosearch, sv, &suidscript);
+	    = open_script(scriptname, dosearch, sv, &suidscript, &rsfp);
 
-	validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv);
+	validate_suid(validarg, scriptname, fdscript, suidscript,
+		linestr_sv, rsfp);
 
 #ifndef PERL_MICRO
 #  if defined(SIGCHLD) || defined(SIGCLD)
@@ -2144,7 +2146,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    forbid_setid('x', suidscript);
 	    /* Hence you can't get here if suidscript >= 0  */
 
-	    find_beginning(linestr_sv);
+	    find_beginning(linestr_sv, rsfp);
 	    if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
 		Perl_croak(aTHX_ "Can't chdir to %s",cddir);
 	}
@@ -2259,10 +2261,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     }
 #endif
 
-    tmpfp = PL_rsfp;
-    PL_rsfp = NULL;
-    lex_start(linestr_sv);
-    PL_rsfp = tmpfp;
+    lex_start(linestr_sv, rsfp);
     PL_subname = newSVpvs("main");
 
     /* now parse the script */
@@ -3584,7 +3583,7 @@ S_init_main_stash(pTHX)
 
 STATIC int
 S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
-	      int *suidscript)
+	      int *suidscript, PerlIO **rsfpp)
 {
 #ifndef IAMSUID
     const char *quote;
@@ -3642,11 +3641,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
     if (*PL_origfilename == '-' && PL_origfilename[1] == '\0')
 	scriptname = (char *)"";
     if (fdscript >= 0) {
-	PL_rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
+	*rsfpp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
 #       if defined(HAS_FCNTL) && defined(F_SETFD)
-	    if (PL_rsfp)
+	    if (*rsfpp)
                 /* ensure close-on-exec */
-	        fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1);
+	        fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1);
 #       endif
     }
 #ifdef IAMSUID
@@ -3728,24 +3727,24 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
                               "PL_preprocess: cmd=\"%s\"\n",
                               SvPVX_const(cmd)));
 
-	PL_rsfp = PerlProc_popen((char *)SvPVX_const(cmd), (char *)"r");
+	*rsfpp = PerlProc_popen((char *)SvPVX_const(cmd), (char *)"r");
 	SvREFCNT_dec(cmd);
 	SvREFCNT_dec(cpp);
     }
     else if (!*scriptname) {
 	forbid_setid(0, *suidscript);
-	PL_rsfp = PerlIO_stdin();
+	*rsfpp = PerlIO_stdin();
     }
     else {
-	PL_rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
+	*rsfpp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
 #       if defined(HAS_FCNTL) && defined(F_SETFD)
-	    if (PL_rsfp)
+	    if (*rsfpp)
                 /* ensure close-on-exec */
-	        fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1);
+	        fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1);
 #       endif
     }
 #endif /* IAMSUID */
-    if (!PL_rsfp) {
+    if (!*rsfpp) {
 	/* PSz 16 Sep 03  Keep neat error message */
 	if (PL_e_script)
 	    Perl_croak(aTHX_ "Can't open "BIT_BUCKET": %s\n", Strerror(errno));
@@ -3892,7 +3891,7 @@ S_fd_on_nosuid_fs(pTHX_ int fd)
 
 STATIC void
 S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
-		int fdscript, int suidscript, SV *linestr_sv)
+		int fdscript, int suidscript, SV *linestr_sv, PerlIO *rsfp)
 {
     dVAR;
 #ifdef IAMSUID
@@ -3929,7 +3928,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
 #ifdef DOSUID
     const char *s, *s2;
 
-    if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0)	/* normal stat is insecure */
+    if (PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf) < 0)	/* normal stat is insecure */
 	Perl_croak(aTHX_ "Can't stat script \"%s\"",PL_origfilename);
     if (PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
 	I32 len;
@@ -4018,7 +4017,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
 	 * Seems safe enough to do as root.
 	 */
 #if !defined(NO_NOSUID_CHECK)
-	if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp))) {
+	if (fd_on_nosuid_fs(PerlIO_fileno(rsfp))) {
 	    Perl_croak(aTHX_ "Setuid script on nosuid or noexec filesystem\n");
 	}
 #endif
@@ -4032,7 +4031,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
 	PL_doswitches = FALSE;		/* -s is insecure in suid */
 	/* PSz 13 Nov 03  But -s was caught elsewhere ... so unsetting it here is useless(?!) */
 	CopLINE_inc(PL_curcop);
-	if (sv_gets(linestr_sv, PL_rsfp, 0) == NULL)
+	if (sv_gets(linestr_sv, rsfp, 0) == NULL)
 	    Perl_croak(aTHX_ "No #! line");
 	linestr = SvPV_nolen_const(linestr_sv);
 	/* required even on Sys V */
@@ -4120,8 +4119,8 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 	     * in fact will use that to distinguish this from "normal"
 	     * usage, see comments above.
 	     */
-	    PerlIO_rewind(PL_rsfp);
-	    PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0);  /* just in case rewind didn't */
+	    PerlIO_rewind(rsfp);
+	    PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0);  /* just in case rewind didn't */
 	    /* PSz 27 Feb 04  Sanity checks on scriptname */
 	    if ((!scriptname) || (!*scriptname) ) {
 		Perl_croak(aTHX_ "No setuid script name\n");
@@ -4138,9 +4137,9 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 		Perl_croak(aTHX_ "Can't change argv to have fd script\n");
 	    }
 	    PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s",
-					  PerlIO_fileno(PL_rsfp), PL_origargv[which]));
+					  PerlIO_fileno(rsfp), PL_origargv[which]));
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-	    fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);	/* ensure no close-on-exec */
+	    fcntl(PerlIO_fileno(rsfp),F_SETFD,0);	/* ensure no close-on-exec */
 #endif
 	    PERL_FPU_PRE_EXEC
 	    PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
@@ -4257,8 +4256,8 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
      * #endif
      * into the perly bits.
      */
-    PerlIO_rewind(PL_rsfp);
-    PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0);  /* just in case rewind didn't */
+    PerlIO_rewind(rsfp);
+    PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0);  /* just in case rewind didn't */
     /* PSz 11 Nov 03
      * Keep original arguments: suidperl already has fd script.
      */
@@ -4268,9 +4267,9 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 /*	Perl_croak(aTHX_ "Permission denied\n");			*/
 /*  }									*/
 /*  PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s",	*/
-/*				  PerlIO_fileno(PL_rsfp), PL_origargv[which]));	*/
+/*				  PerlIO_fileno(rsfp), PL_origargv[which]));	*/
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);	/* ensure no close-on-exec */
+    fcntl(PerlIO_fileno(rsfp),F_SETFD,0);	/* ensure no close-on-exec */
 #endif
     PERL_FPU_PRE_EXEC
     PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP,
@@ -4284,7 +4283,7 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
     PERL_UNUSED_ARG(suidscript);
     if (PL_euid != PL_uid || PL_egid != PL_gid) {	/* (suidperl doesn't exist, in fact) */
 #ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
-	PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf);	/* may be either wrapped or real suid */
+	PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf);	/* may be either wrapped or real suid */
 	if ((PL_euid != PL_uid && PL_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
 	    ||
 	    (PL_egid != PL_gid && PL_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
@@ -4302,7 +4301,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 }
 
 STATIC void
-S_find_beginning(pTHX_ SV* linestr_sv)
+S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
 {
     dVAR;
     register char *s;
@@ -4317,7 +4316,7 @@ S_find_beginning(pTHX_ SV* linestr_sv)
     /* Since the Mac OS does not honor #! arguments for us, we do it ourselves */
 
     while (PL_doextract || gMacPerl_AlwaysExtract) {
-	if ((s = sv_gets(linestr_sv, PL_rsfp, 0)) == NULL) {
+	if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL) {
 	    if (!gMacPerl_AlwaysExtract)
 		Perl_croak(aTHX_ "No Perl script found in input\n");
 
@@ -4328,18 +4327,18 @@ S_find_beginning(pTHX_ SV* linestr_sv)
 		    PL_doextract = FALSE;
 
 	    /* Pater peccavi, file does not have #! */
-	    PerlIO_rewind(PL_rsfp);
+	    PerlIO_rewind(rsfp);
 
 	    break;
 	}
 #else
     while (PL_doextract) {
-	if ((s = sv_gets(linestr_sv, PL_rsfp, 0)) == NULL)
+	if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL)
 	    Perl_croak(aTHX_ "No Perl script found in input\n");
 #endif
 	s2 = s;
 	if (*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL")))) {
-	    PerlIO_ungetc(PL_rsfp, '\n');		/* to keep line count right */
+	    PerlIO_ungetc(rsfp, '\n');		/* to keep line count right */
 	    PL_doextract = FALSE;
 	    while (*s && !(isSPACE (*s) || *s == '#')) s++;
 	    s2 = s;
@@ -4357,7 +4356,7 @@ S_find_beginning(pTHX_ SV* linestr_sv)
 	     * by counting lines we already skipped over
 	     */
 	    for (; maclines > 0 ; maclines--)
-		PerlIO_ungetc(PL_rsfp, '\n');
+		PerlIO_ungetc(rsfp, '\n');
 
 	    break;
 
diff --git a/perlapi.h b/perlapi.h
index 98dd3aaffa..a3e37219ed 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -472,8 +472,6 @@ END_EXTERN_C
 #define PL_rehash_seed_set	(*Perl_Irehash_seed_set_ptr(aTHX))
 #undef  PL_replgv
 #define PL_replgv		(*Perl_Ireplgv_ptr(aTHX))
-#undef  PL_rsfp
-#define PL_rsfp			(*Perl_Irsfp_ptr(aTHX))
 #undef  PL_rsfp_filters
 #define PL_rsfp_filters		(*Perl_Irsfp_filters_ptr(aTHX))
 #undef  PL_runops
diff --git a/pp_ctl.c b/pp_ctl.c
index 26e1cb8363..60b6b0a47d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2745,7 +2745,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     STRLEN len;
 
     ENTER;
-    lex_start(sv);
+    lex_start(sv, NULL);
     SAVETMPS;
     /* switch to eval mode */
 
@@ -3377,11 +3377,10 @@ PP(pp_require)
 
     ENTER;
     SAVETMPS;
-    lex_start(NULL);
+    lex_start(NULL, tryrsfp);
     SAVEGENERICSV(PL_rsfp_filters);
     PL_rsfp_filters = NULL;
 
-    PL_rsfp = tryrsfp;
     SAVEHINTS();
     PL_hints = 0;
     SAVECOMPILEWARNINGS();
@@ -3449,7 +3448,7 @@ PP(pp_entereval)
     TAINT_PROPER("eval");
 
     ENTER;
-    lex_start(sv);
+    lex_start(sv, NULL);
     SAVETMPS;
 
     /* switch to eval mode */
diff --git a/proto.h b/proto.h
index a27ad79302..cbd261cdaa 100644
--- a/proto.h
+++ b/proto.h
@@ -1025,7 +1025,7 @@ PERL_CALLCONV I32	Perl_keyword(pTHX_ const char* d, I32 len, bool all_keywords)
 
 PERL_CALLCONV void	Perl_leave_scope(pTHX_ I32 base);
 PERL_CALLCONV void	Perl_lex_end(pTHX);
-PERL_CALLCONV void	Perl_lex_start(pTHX_ SV* line);
+PERL_CALLCONV void	Perl_lex_start(pTHX_ SV* line, PerlIO *rsfp);
 PERL_CALLCONV void	Perl_op_null(pTHX_ OP* o)
 			__attribute__nonnull__(pTHX_1);
 
@@ -3357,8 +3357,9 @@ STATIC void	S_Slab_to_rw(pTHX_ void *op)
 #endif
 
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
-STATIC void	S_find_beginning(pTHX_ SV* linestr_sv)
-			__attribute__nonnull__(pTHX_1);
+STATIC void	S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2);
 
 STATIC void	S_forbid_setid(pTHX_ const char flag, const int suidscript);
 STATIC void	S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, bool canrelocate);
@@ -3374,18 +3375,21 @@ STATIC void	S_my_exit_jump(pTHX)
 			__attribute__noreturn__;
 
 STATIC void	S_nuke_stacks(pTHX);
-STATIC int	S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv, int *suidscript)
+STATIC int	S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv, int *suidscript, PerlIO **rsfpp)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_3)
-			__attribute__nonnull__(pTHX_4);
+			__attribute__nonnull__(pTHX_4)
+			__attribute__nonnull__(pTHX_5);
 
 STATIC void	S_usage(pTHX_ const char *name)
 			__attribute__nonnull__(pTHX_1);
 
-STATIC void	S_validate_suid(pTHX_ const char *validarg, const char *scriptname, int fdscript, int suidscript, SV* linestr_sv)
+STATIC void	S_validate_suid(pTHX_ const char *validarg, const char *scriptname, int fdscript, int suidscript, SV* linestr_sv, PerlIO *rsfp)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2)
-			__attribute__nonnull__(pTHX_5);
+			__attribute__nonnull__(pTHX_5)
+			__attribute__nonnull__(pTHX_6);
+
 
 #  if defined(IAMSUID)
 STATIC int	S_fd_on_nosuid_fs(pTHX_ int fd);
diff --git a/sv.c b/sv.c
index 4b27b2936b..71fdd43468 100644
--- a/sv.c
+++ b/sv.c
@@ -9576,6 +9576,7 @@ Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param)
     parser->copline	= proto->copline;
     parser->last_lop_op	= proto->last_lop_op;
     parser->lex_state	= proto->lex_state;
+    parser->rsfp	= fp_dup(proto->rsfp, '<', param);
 
 
     parser->linestr	= sv_dup_inc(proto->linestr, param);
@@ -9600,6 +9601,7 @@ Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param)
 	parser->bufend	    = ls + SvCUR(parser->linestr);
     }
 
+
 #ifdef PERL_MAD
     parser->endwhite	= proto->endwhite;
     parser->faketokens	= proto->faketokens;
@@ -11214,7 +11216,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_custom_op_descs  = hv_dup_inc(proto_perl->Icustom_op_descs,param);
 
     PL_profiledata	= NULL;
-    PL_rsfp		= fp_dup(proto_perl->Irsfp, '<', param);
     /* PL_rsfp_filters entries have fake IoDIRP() */
     PL_rsfp_filters	= av_dup_inc(proto_perl->Irsfp_filters, param);
 
diff --git a/toke.c b/toke.c
index 9726a31b71..40eeb2aebe 100644
--- a/toke.c
+++ b/toke.c
@@ -61,6 +61,7 @@
 #define PL_last_lop		(PL_parser->last_lop)
 #define PL_last_lop_op		(PL_parser->last_lop_op)
 #define PL_lex_state		(PL_parser->lex_state)
+#define PL_rsfp			(PL_parser->rsfp)
 
 #ifdef PERL_MAD
 #  define PL_endwhite		(PL_parser->endwhite)
@@ -638,7 +639,7 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen)
  */
 
 void
-Perl_lex_start(pTHX_ SV *line)
+Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp)
 {
     dVAR;
     const char *s = NULL;
@@ -665,7 +666,6 @@ Perl_lex_start(pTHX_ SV *line)
     /* initialise lexer state */
 
     SAVECOPLINE(PL_curcop);
-    SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
 
 #ifdef PERL_MAD
     parser->curforce = -1;
@@ -675,6 +675,8 @@ Perl_lex_start(pTHX_ SV *line)
     parser->copline = NOLINE;
     PL_lex_state = LEX_NORMAL;
     parser->expect = XSTATE;
+    parser->rsfp = rsfp;
+
     Newx(parser->lex_brackstack, 120, char);
     Newx(parser->lex_casestack, 12, char);
     *parser->lex_casestack = '\0';
@@ -702,7 +704,6 @@ Perl_lex_start(pTHX_ SV *line)
 	parser->linestart = SvPVX(parser->linestr);
     parser->bufend = parser->bufptr + SvCUR(parser->linestr);
     parser->last_lop = parser->last_uni = NULL;
-    PL_rsfp = 0;
 }
 
 
@@ -713,6 +714,12 @@ Perl_parser_free(pTHX_  const yy_parser *parser)
 {
     SvREFCNT_dec(parser->linestr);
 
+    if (parser->rsfp == PerlIO_stdin())
+	PerlIO_clearerr(parser->rsfp);
+    else if (parser->rsfp && parser->old_parser
+			  && parser->rsfp != parser->old_parser->rsfp)
+	PerlIO_close(parser->rsfp);
+
     Safefree(parser->stack);
     Safefree(parser->lex_brackstack);
     Safefree(parser->lex_casestack);
@@ -12659,23 +12666,6 @@ S_swallow_bom(pTHX_ U8 *s)
     return (char*)s;
 }
 
-/*
- * restore_rsfp
- * Restore a source filter.
- */
-
-static void
-restore_rsfp(pTHX_ void *f)
-{
-    dVAR;
-    PerlIO * const fp = (PerlIO*)f;
-
-    if (PL_rsfp == PerlIO_stdin())
-	PerlIO_clearerr(PL_rsfp);
-    else if (PL_rsfp && (PL_rsfp != fp))
-	PerlIO_close(PL_rsfp);
-    PL_rsfp = fp;
-}
 
 #ifndef PERL_NO_UTF16_FILTER
 static I32